dslinux/user/perl AUTHORS Artistic Changes Changes5.000 Changes5.001 Changes5.002 Changes5.003 Changes5.004 Changes5.005 Changes5.6 Changes5.8 Changes5.8.1 Changes5.8.2 Changes5.8.3 Changes5.8.4 Changes5.8.5 Changes5.8.6 Changes5.8.7 Configure Copying EXTERN.h INSTALL INTERN.h MANIFEST META.yml Makefile.SH Makefile.micro Policy_sh.SH README README.Y2K README.aix README.amiga README.apollo README.beos README.bs2000 README.ce README.cn README.cygwin README.dgux README.dos README.epoc README.freebsd README.hpux README.hurd README.irix README.jp README.ko README.linux README.machten README.macos README.macosx README.micro README.mint README.mpeix README.netware README.openbsd README.os2 README.os390 README.os400 README.plan9 README.qnx README.solaris README.tru64 README.tw README.uts README.vmesa README.vms README.vos README.win32 Todo.micro XSUB.h autodoc.pl av.c av.h bytecode.pl cc_runtime.h cflags.SH config_h.SH configpm configure.com configure.gnu cop.h cv.h deb.c d! oio.c doop.c dosish.h dump.c embed.fnc embed.h embed.pl embedvar.h fakesdio.h fakethr.h form.h genpacksizetables.pl global.sym globals.c globvar.sym gv.c gv.h handy.h hv.c hv.h installhtml installman installperl intrpvar.h iperlsys.h keywords.h keywords.pl locale.c makeaperl.SH makedef.pl makedepend.SH makedir.SH malloc.c malloc_ctl.h mg.c mg.h minimod.pl miniperlmain.c myconfig.SH nostdio.h numeric.c op.c op.h opcode.h opcode.pl opnames.h pad.c pad.h patchlevel.h perl.c perl.h perl_keyword.pl perlapi.c perlapi.h perlio.c perlio.h perlio.sym perliol.h perlsdio.h perlsfio.h perlsh perlvars.h perly.c perly.fixer perly.h perly.y perly_c.diff perlyline.pl pod.lst pp.c pp.h pp.sym pp_ctl.c pp_hot.c pp_pack.c pp_proto.h pp_sort.c pp_sys.c proto.h reentr.c reentr.h reentr.inc reentr.pl regcomp.c regcomp.h regcomp.pl regcomp.sym regen.pl regen_lib.pl regexec.c regexp.h regnodes.h run.c scope.c scope.h sv.c sv.h taint.c thrdvar.h thread.h toke.c uconfig.h uconfig.sh universal.c unix! ish.h utf8.c utf8.h utfebcdic.h util.c util.h utils.lst warnings.h war
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:58:57 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl
In directory antilope:/tmp/cvs-serv17422
Added Files:
AUTHORS Artistic Changes Changes5.000 Changes5.001
Changes5.002 Changes5.003 Changes5.004 Changes5.005 Changes5.6
Changes5.8 Changes5.8.1 Changes5.8.2 Changes5.8.3 Changes5.8.4
Changes5.8.5 Changes5.8.6 Changes5.8.7 Configure Copying
EXTERN.h INSTALL INTERN.h MANIFEST META.yml Makefile.SH
Makefile.micro Policy_sh.SH README README.Y2K README.aix
README.amiga README.apollo README.beos README.bs2000 README.ce
README.cn README.cygwin README.dgux README.dos README.epoc
README.freebsd README.hpux README.hurd README.irix README.jp
README.ko README.linux README.machten README.macos
README.macosx README.micro README.mint README.mpeix
README.netware README.openbsd README.os2 README.os390
README.os400 README.plan9 README.qnx README.solaris
README.tru64 README.tw README.uts README.vmesa README.vms
README.vos README.win32 Todo.micro XSUB.h autodoc.pl av.c av.h
bytecode.pl cc_runtime.h cflags.SH config_h.SH configpm
configure.com configure.gnu cop.h cv.h deb.c doio.c doop.c
dosish.h dump.c embed.fnc embed.h embed.pl embedvar.h
fakesdio.h fakethr.h form.h genpacksizetables.pl global.sym
globals.c globvar.sym gv.c gv.h handy.h hv.c hv.h installhtml
installman installperl intrpvar.h iperlsys.h keywords.h
keywords.pl locale.c makeaperl.SH makedef.pl makedepend.SH
makedir.SH malloc.c malloc_ctl.h mg.c mg.h minimod.pl
miniperlmain.c myconfig.SH nostdio.h numeric.c op.c op.h
opcode.h opcode.pl opnames.h pad.c pad.h patchlevel.h perl.c
perl.h perl_keyword.pl perlapi.c perlapi.h perlio.c perlio.h
perlio.sym perliol.h perlsdio.h perlsfio.h perlsh perlvars.h
perly.c perly.fixer perly.h perly.y perly_c.diff perlyline.pl
pod.lst pp.c pp.h pp.sym pp_ctl.c pp_hot.c pp_pack.c
pp_proto.h pp_sort.c pp_sys.c proto.h reentr.c reentr.h
reentr.inc reentr.pl regcomp.c regcomp.h regcomp.pl
regcomp.sym regen.pl regen_lib.pl regexec.c regexp.h
regnodes.h run.c scope.c scope.h sv.c sv.h taint.c thrdvar.h
thread.h toke.c uconfig.h uconfig.sh universal.c unixish.h
utf8.c utf8.h utfebcdic.h util.c util.h utils.lst warnings.h
warnings.pl writemain.SH xsutils.c
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: toke.c ---
/* toke.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "It all comes from here, the stench and the peril." --Frodo
*/
/*
* This file is the lexer for Perl. It's closely linked to the
* parser, perly.y.
*
* The main routine is yylex(), which returns the next token.
[...10977 lines suppressed...]
}
while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_'))
pos++;
}
SvPOK_on(sv);
sv_magic(sv,NULL,PERL_MAGIC_vstring,(const char*)start, pos-start);
SvRMAGICAL_on(sv);
}
return (char *)s;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.machten ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specially designed to be readable as is.
=head1 NAME
README.machten - Perl version 5 on Power MachTen systems
=head1 DESCRIPTION
This document describes how to build Perl 5 on Power MachTen systems,
and discusses a few wrinkles in the implementation.
=head2 Perl version 5.8.x and greater not supported
B<Power MachTen is not supported by versions of Perl later than
5.6.x.>
If you wish to build a version from the 5.6 track, please
obtain a source distribution from the archive at
L<http://cpan.org/src/5.0/> and follow the instructions in its
README.machten file.
MachTen is no longer supported by its developers, Tenon Intersystems.
A UNIX environment hosted on Mac OS Classic, MachTen has been
superseded by Mac OS X and by BSD and Linux implementations for Macintosh
hardware.
The final version of Power MachTen, 4.1.4, lacks many features found in
modern implementations of UNIX, and has a number of bugs.
These shortcomings prevent recent versions of Perl from being able to use
extensions on MachTen, and cause numerous test suite failures in the
perl core.
In September 2003, a discussion on the MachTen mailing list determined
that there was no interest in making a later version of Perl build
successfully on MachTen.
Consequently, support for building Perl under MachTen has been suppressed
in Perl distributions published after February 2004.
The hints file, F<hints/machten.sh>, remains a part of the
distributions for reference purposes.
=head2 Compiling Perl 5.6.x on MachTen
To compile perl 5.6.x under MachTen 4.1.4 (and probably earlier versions):
./Configure -de
make
make test
make install
This builds and installs a statically-linked perl; MachTen's dynamic
linking facilities are not adequate to support Perl's use of
dynamically linked libraries. (See F<hints/machten.sh> for more
information.)
You should have at least 32 megabytes of free memory on your
system before running the C<make> command.
For much more information on building perl -- for example, on how to
change the default installation directory -- see F<INSTALL>.
=head2 Failures during C<make test> on MachTen
=over 4
=item op/lexassign.t
This test may fail when first run after building perl. It does not
fail subsequently. The cause is unknown.
=item pragma/warnings.t
Test 257 fails due to a failure to warn about attempts to read from a
filehandle which is a duplicate of stdout when stdout is attached to a
pipe. The output of the test contains a block comment which discusses
a different failure, not applicable to MachTen.
The root of the problem is that Machten does not assign a file type to
either end of a pipe (see L<stat>), resulting, among other things
in Perl's C<-p> test failing on file descriptors belonging to pipes.
As a result, perl becomes confused, and the test for reading from a
write-only file fails. I am reluctant to patch perl to get around
this, as it's clearly an OS bug (about which Tenon has been informed),
and limited in its effect on practical Perl programs.
=back
=head2 Building external modules on MachTen
To add an external module to perl, build in the normal way, which
is documented in L<ExtUtils::MakeMaker>, or which can be driven
automatically by the CPAN module (see L<CPAN>), which is part of the
standard distribution. If you want to install a module which
contains XS code (C or C++ source which compiles to object code
for linking with perl), you will have to replace your perl binary with
a new version containing the new statically-linked object module. The
build process tells you how to do this.
There is a gotcha, however, which users usually encounter immediately
they respond to CPAN's invitation to C<install Bundle::CPAN>. When
installing a I<bundle> -- a group of modules which together achieve
some particular purpose, the installation process for later modules in
the bundle tends to assume that earlier modules have been fully
installed and are available for use. This is not true on a
statically-linked system for earlier modules which contain XS code.
As a result the installation of the bundle fails. The work-around is
not to install the bundle as a one-shot operation, but instead to see
what modules it contains, and install these one-at-a-time by hand in
the order given.
=head1 AUTHOR
Dominic Dunlop <domo at computer.org>
=head1 DATE
Version 1.1.0 2004-02-13
--- NEW FILE: perlsfio.h ---
/* perlsfio.h
*
* Copyright (C) 1996, 1999, 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* The next #ifdef should be redundant if Configure behaves ... */
#ifndef FILE
#define FILE FILE
#endif
#ifdef I_SFIO
#include <sfio.h>
#endif
/* sfio 2000 changed _stdopen to _stdfdopen */
#if SFIO_VERSION >= 20000101L
#define _stdopen _stdfdopen
#endif
extern Sfio_t* _stdopen _ARG_((int, const char*));
extern int _stdprintf _ARG_((const char*, ...));
#define PerlIO Sfio_t
#define PerlIO_stderr() sfstderr
#define PerlIO_stdout() sfstdout
#define PerlIO_stdin() sfstdin
#define PerlIO_isutf8(f) 0
#define PerlIO_printf sfprintf
#define PerlIO_stdoutf _stdprintf
#define PerlIO_vprintf(f,fmt,a) sfvprintf(f,fmt,a)
#define PerlIO_read(f,buf,count) sfread(f,buf,count)
#define PerlIO_write(f,buf,count) sfwrite(f,buf,count)
#define PerlIO_open(path,mode) sfopen(NULL,path,mode)
#define PerlIO_fdopen(fd,mode) _stdopen(fd,mode)
#define PerlIO_reopen(path,mode,f) sfopen(f,path,mode)
#define PerlIO_close(f) sfclose(f)
#define PerlIO_puts(f,s) sfputr(f,s,-1)
#define PerlIO_putc(f,c) sfputc(f,c)
#define PerlIO_ungetc(f,c) sfungetc(f,c)
#define PerlIO_sprintf sfsprintf
#define PerlIO_getc(f) sfgetc(f)
#define PerlIO_eof(f) sfeof(f)
#define PerlIO_error(f) sferror(f)
#define PerlIO_fileno(f) sffileno(f)
#define PerlIO_clearerr(f) sfclrerr(f)
#define PerlIO_flush(f) sfsync(f)
#define PerlIO_tell(f) sftell(f)
#define PerlIO_seek(f,o,w) sfseek(f,o,w)
#define PerlIO_rewind(f) (void) sfseek((f),0L,0)
#define PerlIO_tmpfile() sftmp(0)
#define PerlIO_exportFILE(f,fl) Perl_croak(aTHX_ "Export to FILE * unimplemented")
#define PerlIO_releaseFILE(p,f) Perl_croak(aTHX_ "Release of FILE * unimplemented")
#define PerlIO_setlinebuf(f) sfset(f,SF_LINE,1)
/* Now our interface to equivalent of Configure's FILE_xxx macros */
#define PerlIO_has_cntptr(f) 1
#define PerlIO_get_ptr(f) ((f)->next)
#define PerlIO_get_cnt(f) ((f)->endr - (f)->next)
#define PerlIO_canset_cnt(f) 1
#define PerlIO_fast_gets(f) 1
#define PerlIO_set_ptrcnt(f,p,c) STMT_START {(f)->next = (unsigned char *)(p); assert(PerlIO_get_cnt(f) == (c));} STMT_END
#define PerlIO_set_cnt(f,c) STMT_START {(f)->next = (f)->endr - (c);} STMT_END
#define PerlIO_has_base(f) 1
#define PerlIO_get_base(f) ((f)->data)
#define PerlIO_get_bufsiz(f) ((f)->endr - (f)->data)
--- NEW FILE: INTERN.h ---
/* INTERN.h
*
* Copyright (C) 1991, 1992, 1993, 1995, 1996, 1998, 2000, 2001,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* EXT designates a global var which is defined in perl.h
* dEXT designates a global var which is defined in another
* file, so we can't count on finding it in perl.h
* (this practice should be avoided).
*/
#undef EXT
#undef dEXT
#undef EXTCONST
#undef dEXTCONST
#if defined(VMS) && !defined(__GNUC__)
/* Suppress portability warnings from DECC for VMS-specific extensions */
# ifdef __DECC
# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
# endif
# define EXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
#if defined(WIN32) && defined(__MINGW32__)
# define EXT __declspec(dllexport)
# define dEXT
# define EXTCONST __declspec(dllexport) const
# define dEXTCONST const
#else
#ifdef __cplusplus
# define EXT
# define dEXT
# define EXTCONST extern const
# define dEXTCONST const
#else
# define EXT
# define dEXT
# define EXTCONST const
# define dEXTCONST const
#endif
#endif
#endif
#undef INIT
#define INIT(x) = x
#define DOINIT
--- NEW FILE: opcode.h ---
/* -*- buffer-read-only: t -*-
*
* opcode.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by opcode.pl from its data. Any changes made here
* will be lost!
*/
#define Perl_pp_i_preinc Perl_pp_preinc
#define Perl_pp_i_predec Perl_pp_predec
#define Perl_pp_i_postinc Perl_pp_postinc
#define Perl_pp_i_postdec Perl_pp_postdec
[...1791 lines suppressed...]
0x00000000, /* gpwent */
0x00000014, /* spwent */
0x00000014, /* epwent */
0x00003600, /* ggrnam */
0x00003600, /* ggrgid */
0x00000000, /* ggrent */
0x00000014, /* sgrent */
0x00000014, /* egrent */
0x0000000c, /* getlogin */
0x0004281d, /* syscall */
0x0000f604, /* lock */
0x00000044, /* threadsv */
0x00001404, /* setstate */
0x00000c40, /* method_named */
0x00000000, /* custom */
};
#endif
END_EXTERN_C
/* ex: set ro: */
--- NEW FILE: Changes5.003 ---
-------------
Version 5.003
-------------
***> IMPORTANT NOTICE: <***
The main reason for this release was to fix a security bug affecting
suidperl on some systems. If you build suidperl on your system, it
is strongly recommended that you replace any existing copies with
version 5.003 or later immediately.
The changes in 5.003 have been held to a minimum, in the hope that this
will simplify installation and testing at sites which may be affected
by the security hole in suidperl. In brief, 5.003 does the following:
- Plugs security hole in suidperl mechanism on affected systems
- MakeMaker was also updated to version 5.34, and extension Makefile.PLs
were modified to match it.
- The following hints files were updated: bsdos.sh, hpux.sh, linux.sh,
machten.sh, solaris_2.sh
- A fix was added to installperl to insure that file permissions were
set correctly for the installed C header files.
- t/op/stat.t was modified to work around MachTen's belief that /dev/null
is a terminal device.
- Incorporation of Perl version information into the VMS' version of
config.h was changed to make it compatible with the older VAXC.
- Minor fixes were made to VMS-specific C code, and the routine
VMS::Filespec::rmsexpand was added.
----------------
Version 5.002_01
----------------
- The EMBED namespace changes are now used by default, in order to better
segregate Perl's C global symbols from those belonging to embedding
applications or to libraries. This makes it necessary to rebuild dynamic
extensions built under previous versions of Perl without the EMBED option.
The default use of EMBED can be overridden by placing -DNO_EMBED on the
cc command line.
The EMBED change is the beginning of a general cleanup of C global
symbols used by Perl, so binary compatibility with previously
compiled dynamic extensions may be broken again in the next few
releases.
- Several bugs in the core were fixed, including the following:
- made sure FILE * for -e temp file was closed only once
- improved form of single-statement macro definitions to keep
as many ccs as possible happy
- fixed file tests to insure that signed values were used when
computing differences between times.
- fixed toke.c so implicit loop isn't doubled when perl is
invoked with both the -p and -n switches
- The new SUBVERSION number has been included in the default value for
architecture-specific library directories, so development and
production architecture-dependent libraries can coexist.
- Two new magic variables, $^E and $^O, have been added. $^E contains the
OS-specific equivalent of $!. $^O contains the name of the operating
system, in order to make it easily available to Perl code whose behavior
differs according to its environment. The standard library files have
been converted to use $^O in preference to $Config{'osname'}.
- A mechanism was added to allow listing of locally applied patches
in the output of perl -v.
- Miscellaneous minor corrections and updates were made to the documentation.
- Extensive updates were made to the OS/2 and VMS ports
- The following hints file were updated: bsdos.sh, dynixptx.sh,
irix_6_2.sh, linux.sh, os2.sh
- Several changes were made to standard library files:
- reduced use of English.pm and $`, $', and $& in library modules,
since these degrade module loading and evaluation of regular expressions,
respectively.
- File/Basename.pm: Added path separator to dirname('.')
- File/Copy.pm: Added support for VMS and OS/2 system-level copy
- MakeMaker updated to v5.26
- Symbol.pm now accepts old (') and new (::) package delimiters
- Sys/Syslog.pm uses Sys::Hostname only when necessary
- chat2.pl picks up necessary constants from socket.ph
- syslog.pl: Corrected thinko 'Socket' --> 'Syslog'
- xsubpp updated to v1.935
- The perlbug utility is now more cautious about sending mail, in order
to reduce the chance of accidentally send a bug report by giving the
wrong response to a prompt.
- The -m switch has been added to perldoc, causing it to display the
Perl code in target file as well as any documentation.
--- NEW FILE: Changes5.000 ---
-------------
Version 5.000
-------------
New things
----------
The -w switch is much more informative.
References. See t/op/ref.t for examples. All entities in Perl 5 are
reference counted so that it knows when each item should be destroyed.
Objects. See t/op/ref.t for examples.
=> is now a synonym for comma. This is useful as documentation for
arguments that come in pairs, such as initializers for associative arrays,
or named arguments to a subroutine.
All functions have been turned into list operators or unary operators,
meaning the parens are optional. Even subroutines may be called as
list operators if they've already been declared.
More embeddible. See main.c and embed_h.sh. Multiple interpreters
in the same process are supported (though not with interleaved
execution yet).
The interpreter is now flattened out. Compare Perl 4's eval.c with
the perl 5's pp.c. Compare Perl 4's 900 line interpreter loop in cmd.c
with Perl 5's 1 line interpreter loop in run.c. Eventually we'll make
everything non-blocking so we can interface nicely with a scheduler.
eval is now treated more like a subroutine call. Among other things,
this means you can return from it.
Format value lists may be spread over multiple lines by enclosing in
a do {} block.
You may now define BEGIN and END subroutines for each package. The BEGIN
subroutine executes the moment it's parsed. The END subroutine executes
just before exiting.
Flags on the #! line are interpreted even if the script wasn't
executed directly. (And even if the script was located by "perl -x"!)
The ?: operator is now legal as an lvalue.
List context now propagates to the right side of && and ||, as well
as the 2nd and 3rd arguments to ?:.
The "defined" function can now take a general expression.
Lexical scoping available via "my". eval can see the current lexical
variables.
The preferred package delimiter is now :: rather than '.
tie/untie are now preferred to dbmopen/dbmclose. Multiple DBM
implementations are allowed in the same executable, so you can
write scripts to interchange data among different formats.
New "and" and "or" operators work just like && and || but with
a precedence lower than comma, so they work better with list operators.
New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst(),
chomp(), glob()
require with a number checks to see that the version of Perl that is
currently running is at least that number.
Dynamic loading of external modules is now supported.
There is a new quote form qw//, which is equivalent to split(' ', q//).
Assignment of a reference to a glob value now just replaces the
single element of the glob corresponding to the reference type:
*foo = \$bar, *foo = \&bletch;
Filehandle methods are now supported:
output_autoflush STDOUT 1;
There is now an "English" module that provides human readable translations
for cryptic variable names.
Autoload stubs can now call the replacement subroutine with goto &realsub.
Subroutines can be defined lazily in any package by declaring an AUTOLOAD
routine, which will be called if a non-existent subroutine is called in
that package.
Several previously added features have been subsumed under the new
keywords "use" and "no". Saying "use Module LIST" is short for
BEGIN { require Module; import Module LIST; }
The "no" keyword is identical except that it calls "unimport" instead.
The earlier pragma mechanism now uses this mechanism, and two new
modules have been added to the library to implement "use integer"
and variations of "use strict vars, refs, subs".
Variables may now be interpolated literally into a pattern by prefixing
them with \Q, which works just like \U, but backwhacks non-alphanumerics
instead. There is also a corresponding quotemeta function.
Any quantifier in a regular expression may now be followed by a ? to
indicate that the pattern is supposed to match as little as possible.
Pattern matches may now be followed by an m or s modifier to explicitly
request multiline or singleline semantics. An s modifier makes . match
newline.
Patterns may now contain \A to match only at the beginning of the string,
and \Z to match only at the end. These differ from ^ and $ in that
they ignore multiline semantics. In addition, \G matches where the
last interation of m//g or s///g left off.
Non-backreference-producing parens of various sorts may now be
indicated by placing a ? directly after the opening parenthesis,
followed by a character that indicates the purpose of the parens.
An :, for instance, indicates simple grouping. (?:a|b|c) will
match any of a, b or c without producing a backreference. It does
"eat" the input. There are also assertions which do not eat the
input but do lookahead for you. (?=stuff) indicates that the next
thing must be "stuff". (?!nonsense) indicates that the next thing
must not be "nonsense".
The negation operator now treats non-numeric strings specially.
A -"text" is turned into "-text", so that -bareword is the same
as "-bareword". If the string already begins with a + or -, it
is flipped to the other sign.
Incompatibilities
-----------------
@ now always interpolates an array in double-quotish strings. Some programs
may now need to use backslash to protect any @ that shouldn't interpolate.
Ordinary variables starting with underscore are no longer forced into
package main.
s'$lhs'$rhs' now does no interpolation on either side. It used to
interplolate $lhs but not $rhs.
The second and third arguments of splice are now evaluated in scalar
context (like the book says) rather than list context.
Saying "shift @foo + 20" is now a semantic error because of precedence.
"open FOO || die" is now incorrect. You need parens around the filehandle.
The elements of argument lists for formats are now evaluated in list
context. This means you can interpolate list values now.
You can't do a goto into a block that is optimized away. Darn.
It is no longer syntactically legal to use whitespace as the name
of a variable, or as a delimiter for any kind of quote construct.
Some error messages will be different.
The caller function now returns a false value in a scalar context if there
is no caller. This lets library files determine if they're being required.
m//g now attaches its state to the searched string rather than the
regular expression.
"reverse" is no longer allowed as the name of a sort subroutine.
taintperl is no longer a separate executable. There is now a -T
switch to turn on tainting when it isn't turned on automatically.
Symbols starting with _ are no longer forced into package main, except
for $_ itself (and @_, etc.).
Double-quoted strings may no longer end with an unescaped $ or @.
Negative array subscripts now count from the end of the array.
The comma operator in a scalar context is now guaranteed to give a
scalar context to its arguments.
The ** operator now binds more tightly than unary minus.
Setting $#array lower now discards array elements so that destructors
work reasonably.
delete is not guaranteed to return the old value for tied arrays,
since this capability may be onerous for some modules to implement.
Attempts to set $1 through $9 now result in a run-time error.
--- NEW FILE: Changes5.001 ---
-------------
Version 5.001
-------------
Nearly all the changes for 5.001 were bug fixes of one variety or another,
so here's the bug list, along with the "resolution" for each of them. If
you wish to correspond about any of them, please include the bug number.
There were a few that can be construed as enhancements:
NETaa13059: now warns of use of \1 where $1 is necessary.
NETaa13512: added $SIG{__WARN__} and $SIG{__DIE__} hooks
NETaa13520: added closures
NETaa13530: scalar keys now resets hash iterator
NETaa13641: added Tim's fancy new import whizbangers
NETaa13710: cryptswitch needed to be more "useable"
NETaa13716: Carp now allows multiple packages to be skipped out of
NETaa13716: now counts imported routines as "defined" for redef warnings
(and, of course, much of the stuff from the perl5-porters)
[...1260 lines suppressed...]
Now indicates that OBJECT->$method() works.
NETaa13715: PACK->$method produces spurious warning
From: Larry Wall
Files patched: toke.c
The -> operator was telling the lexer to expect an operator when the
next thing was a variable.
NETaa13716: Carp now allows multiple packages to be skipped out of
From: Larry Wall
Files patched: lib/Carp.pm
The subroutine redefinition warnings now warn on import collisions.
NETaa13716: Exporter catches warnings and gives a better line number
Files patched: lib/Exporter.pm
(same)
NETaa13716: now counts imported routines as "defined" for redef warnings
Files patched: op.c sv.c
(same)
--- NEW FILE: perlyline.pl ---
$line = 1;
while (<>)
{
$line++;
# 1st correct #line directives for perly.c itself
s/^(#line\s+)\d+(\s*"perly\.c"\s*)$/$1$line$2/;
# now add () round things gcc dislikes
s/if \(yyn = yydefred\[yystate\]\)/if ((yyn = yydefred[yystate]))/;
s/if \(yys = getenv\("YYDEBUG"\)\)/if ((yys = getenv("YYDEBUG")))/;
print;
}
--- NEW FILE: Changes5.004 ---
Please note: This file provides a summary of significant changes
between versions and sub-versions of Perl, not necessarily a complete
list of each modification. If you'd like more detailed information,
please consult the comments in the patches on which the relevant
release of Perl is based. (Patches can be found on any CPAN
site, in the .../src/5.0 directory for full version releases,
or in the .../src/5/0/unsupported directory for sub-version
releases.)
---------------
CAST AND CREW
---------------
To give due honor to those who have made Perl 5.004 what is is today,
here are some of the more common names in the Changes file, and their
current addresses (as of March 1997):
Gisle Aas <gisle at aas.no>
[...16034 lines suppressed...]
- Support for OS/2 has been extended as well, and now includes
options for building a.out binaries.
- Support for VMS has also been extended, incorporating improved
processing of file specification strings, optional suppression of
carriage control interpretation for record-structured files,
improved support for the -S command line switch, a number of
VMS-specific bugfixes, and significantly improved performance
in line-oriented reading of files.
- Several hints files have been added or updated: aux.sh (updated),
convexos.sh (updated), irix_4.sh (updated), irix_5.sh (updated),
irix_6_2.sh (updated), next_3.sh (updated), next_3_2.sh (new),
next_3_3.sh (new), next_4.sh (new), os2/sh (updated),
sco.sh (updated), and solaris_2.sh (updated).
- The test driver for the regression tests now reports when a set
of tests have been skipped (presumable because the operation
they're designed to test isn't supported on the current system).
--- NEW FILE: Changes5.005 ---
Please note: This file provides a summary of significant changes
between versions and sub-versions of Perl, not necessarily a complete
list of each modification. If you'd like more detailed information,
please consult the comments in the patches on which the relevant
release of Perl is based. (Patches can be found on any CPAN
site, in the .../src/5.0 directory for full version releases,
or in the .../src/5/0/unsupported directory for sub-version
releases.)
---------------
CAST AND CREW
---------------
To give due honor to those who have made Perl what is is today,
here are some of the more common names in the Changes file, and their
current addresses (as of July 1998):
Gisle Aas <gisle at aas.no>
[...19302 lines suppressed...]
+ t/op/repeat.t t/op/sleep.t t/op/sort.t t/op/split.t
+ t/op/sprintf.t t/op/stat.t t/op/study.t t/op/subst.t
+ t/op/substr.t t/op/time.t t/op/undef.t t/op/unshift.t
+ t/op/vec.t t/op/write.t t/re_tests taint.c toke.c unixish.h
+ util.c util.h utils/Makefile utils/c2ph.PL utils/h2ph.PL
+ utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL
+ vms/Makefile vms/config.vms vms/descrip.mms
+ vms/ext/Filespec.pm vms/ext/Stdio/0README.txt
+ vms/ext/Stdio/Makefile.PL vms/ext/Stdio/Stdio.pm
+ vms/ext/Stdio/Stdio.xs vms/ext/Stdio/test.pl vms/fndvers.com
+ vms/gen_shrfls.pl vms/genconfig.pl vms/genopt.com
+ vms/make_command.com vms/mms2make.pl vms/myconfig.com
+ vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms
+ vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c
+ vms/vms_yfix.pl vms/vmsish.h vms/writemain.pl writemain.SH
+ x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h
+ x2p/a2p.man x2p/a2p.y x2p/a2py.c x2p/cflags.SH
+ x2p/find2perl.PL x2p/handy.h x2p/hash.c x2p/hash.h x2p/s2p.PL
+ x2p/s2p.man x2p/str.c x2p/str.h x2p/util.c x2p/util.h
+ x2p/walk.c
--- NEW FILE: gv.c ---
/* gv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure
* of your inquisitiveness, I shall spend all the rest of my days answering
* you. What more do you want to know?'
* 'The names of all the stars, and of all living things, and the whole
* history of Middle-earth and Over-heaven and of the Sundering Seas,'
* laughed Pippin.
*/
[...1985 lines suppressed...]
case '8':
case '9':
yes:
return TRUE;
default:
break;
}
}
return FALSE;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.Y2K ---
The following information about Perl and the year 2000 is a modified
version of the information that can be found in the Frequently Asked
Question (FAQ) documents.
Does Perl have a year 2000 problem? Is Perl Y2K compliant?
Short answer: No, Perl does not have a year 2000 problem. Yes,
Perl is Y2K compliant (whatever that means). The
programmers you've hired to use it, however, probably are
not. If you want perl to complain when your programmers
create programs with certain types of possible year 2000
problems, a build option allows you to turn on warnings.
Long answer: The question belies a true understanding of the
issue. Perl is just as Y2K compliant as your pencil
--no more, and no less. Can you use your pencil to write
a non-Y2K-compliant memo? Of course you can. Is that
the pencil's fault? Of course it isn't.
The date and time functions supplied with perl (gmtime and
localtime) supply adequate information to determine the
year well beyond 2000 (2038 is when trouble strikes for
32-bit machines). The year returned by these functions
when used in a list context is the year minus 1900. For
years between 1910 and 1999 this happens to be a 2-digit
decimal number. To avoid the year 2000 problem simply do
not treat the year as a 2-digit number. It isn't.
When gmtime() and localtime() are used in scalar context
they return a timestamp string that contains a fully-
expanded year. For example, $timestamp =
gmtime(1005613200) sets $timestamp to "Tue Nov 13 01:00:00
2001". There's no year 2000 problem here.
That doesn't mean that Perl can't be used to create non-
Y2K compliant programs. It can. But so can your pencil.
It's the fault of the user, not the language. At the risk
of inflaming the NRA: ``Perl doesn't break Y2K, people
do.'' See http://language.perl.com/news/y2k.html for a
longer exposition.
If you want perl to warn you when it sees a program which
concatenates a number with the string "19" -- a common
indication of a year 2000 problem -- build perl using the
Configure option "-Accflags=-DPERL_Y2KWARN".
(See the file INSTALL for more information about building
perl.)
--- NEW FILE: gv.h ---
/* gv.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
struct gp {
SV * gp_sv; /* scalar value */
U32 gp_refcnt; /* how many globs point to this? */
struct io * gp_io; /* filehandle value */
CV * gp_form; /* format value */
AV * gp_av; /* array value */
HV * gp_hv; /* hash value */
GV * gp_egv; /* effective gv, if *glob */
CV * gp_cv; /* subroutine value */
U32 gp_cvgen; /* generational validity of cached gv_cv */
U32 gp_flags; /* XXX unused */
line_t gp_line; /* line first declared at (for -w) */
char * gp_file; /* file first declared in (for -w) */
};
#define GvXPVGV(gv) ((XPVGV*)SvANY(gv))
#define GvGP(gv) (GvXPVGV(gv)->xgv_gp)
#define GvNAME(gv) (GvXPVGV(gv)->xgv_name)
#define GvNAMELEN(gv) (GvXPVGV(gv)->xgv_namelen)
#define GvSTASH(gv) (GvXPVGV(gv)->xgv_stash)
#define GvFLAGS(gv) (GvXPVGV(gv)->xgv_flags)
/*
=head1 GV Functions
=for apidoc Am|SV*|GvSV|GV* gv
Return the SV from the GV.
=cut
*/
#define GvSV(gv) (GvGP(gv)->gp_sv)
#ifdef PERL_DONT_CREATE_GVSV
#define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \
&(GvGP(gv)->gp_sv) : \
&(GvGP(gv_SVadd(gv))->gp_sv)))
#else
#define GvSVn(gv) GvSV(gv)
#endif
#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt)
#define GvIO(gv) ((gv) && SvTYPE((SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : 0)
#define GvIOp(gv) (GvGP(gv)->gp_io)
#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
#define GvFORM(gv) (GvGP(gv)->gp_form)
#define GvAV(gv) (GvGP(gv)->gp_av)
/* This macro is deprecated. Do not use! */
#define GvREFCNT_inc(gv) ((GV*)SvREFCNT_inc(gv)) /* DO NOT USE */
#define GvAVn(gv) (GvGP(gv)->gp_av ? \
GvGP(gv)->gp_av : \
GvGP(gv_AVadd(gv))->gp_av)
#define GvHV(gv) ((GvGP(gv))->gp_hv)
#define GvHVn(gv) (GvGP(gv)->gp_hv ? \
GvGP(gv)->gp_hv : \
GvGP(gv_HVadd(gv))->gp_hv)
#define GvCV(gv) (GvGP(gv)->gp_cv)
#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen)
#define GvCVu(gv) (GvGP(gv)->gp_cvgen ? Nullcv : GvGP(gv)->gp_cv)
#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags)
#define GvLINE(gv) (GvGP(gv)->gp_line)
#define GvFILE(gv) (GvGP(gv)->gp_file)
#define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv)))
#define GvEGV(gv) (GvGP(gv)->gp_egv)
#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv)
#define GVf_INTRO 0x01
#define GVf_MULTI 0x02
#define GVf_ASSUMECV 0x04
#define GVf_IN_PAD 0x08
#define GVf_IMPORTED 0xF0
#define GVf_IMPORTED_SV 0x10
#define GVf_IMPORTED_AV 0x20
#define GVf_IMPORTED_HV 0x40
#define GVf_IMPORTED_CV 0x80
#define GvINTRO(gv) (GvFLAGS(gv) & GVf_INTRO)
#define GvINTRO_on(gv) (GvFLAGS(gv) |= GVf_INTRO)
#define GvINTRO_off(gv) (GvFLAGS(gv) &= ~GVf_INTRO)
#define GvMULTI(gv) (GvFLAGS(gv) & GVf_MULTI)
#define GvMULTI_on(gv) (GvFLAGS(gv) |= GVf_MULTI)
#define GvMULTI_off(gv) (GvFLAGS(gv) &= ~GVf_MULTI)
#define GvASSUMECV(gv) (GvFLAGS(gv) & GVf_ASSUMECV)
#define GvASSUMECV_on(gv) (GvFLAGS(gv) |= GVf_ASSUMECV)
#define GvASSUMECV_off(gv) (GvFLAGS(gv) &= ~GVf_ASSUMECV)
#define GvIMPORTED(gv) (GvFLAGS(gv) & GVf_IMPORTED)
#define GvIMPORTED_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED)
#define GvIMPORTED_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED)
#define GvIMPORTED_SV(gv) (GvFLAGS(gv) & GVf_IMPORTED_SV)
#define GvIMPORTED_SV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_SV)
#define GvIMPORTED_SV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_SV)
#define GvIMPORTED_AV(gv) (GvFLAGS(gv) & GVf_IMPORTED_AV)
#define GvIMPORTED_AV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_AV)
#define GvIMPORTED_AV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_AV)
#define GvIMPORTED_HV(gv) (GvFLAGS(gv) & GVf_IMPORTED_HV)
#define GvIMPORTED_HV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_HV)
#define GvIMPORTED_HV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_HV)
#define GvIMPORTED_CV(gv) (GvFLAGS(gv) & GVf_IMPORTED_CV)
#define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV)
#define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
#define GvIN_PAD(gv) (GvFLAGS(gv) & GVf_IN_PAD)
#define GvIN_PAD_on(gv) (GvFLAGS(gv) |= GVf_IN_PAD)
#define GvIN_PAD_off(gv) (GvFLAGS(gv) &= ~GVf_IN_PAD)
/* XXX: all GvFLAGS options are used, borrowing GvGPFLAGS for the moment */
#define GVf_UNIQUE 0x0001
#define GvUNIQUE(gv) (GvGP(gv) && (GvGPFLAGS(gv) & GVf_UNIQUE))
#define GvUNIQUE_on(gv) (GvGPFLAGS(gv) |= GVf_UNIQUE)
#define GvUNIQUE_off(gv) (GvGPFLAGS(gv) &= ~GVf_UNIQUE)
#ifdef USE_ITHREADS
#define GV_UNIQUE_CHECK
#else
#undef GV_UNIQUE_CHECK
#endif
#define Nullgv Null(GV*)
#define DM_UID 0x003
#define DM_RUID 0x001
#define DM_EUID 0x002
#define DM_GID 0x030
#define DM_RGID 0x010
#define DM_EGID 0x020
#define DM_DELAY 0x100
/*
* symbol creation flags, for use in gv_fetchpv() and get_*v()
*/
#define GV_ADD 0x01 /* add, if symbol not already there */
#define GV_ADDMULTI 0x02 /* add, pretending it has been added already */
#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */
#define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */
#define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */
#define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE)
#define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
--- NEW FILE: MANIFEST ---
apollo/netinet/in.h Apollo DomainOS port: C header file frontend
Artistic The "Artistic License"
AUTHORS Contact info for contributors
autodoc.pl Creates pod/perlintern.pod and pod/perlapi.pod
av.c Array value code
av.h Array value header
beos/beos.c BeOS port
beos/beosish.h BeOS port
beos/nm.c BeOS port
bytecode.pl Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c and ext/B/Asmdata.pm
cc_runtime.h Macros need by runtime of compiler-generated code
cflags.SH A script that emits C compilation flags per file
Changes Differences from previous version
Changes5.000 Differences between 4.x and 5.000
Changes5.001 Differences between 5.000 and 5.001
Changes5.002 Differences between 5.001 and 5.002
Changes5.003 Differences between 5.002 and 5.003
Changes5.004 Differences between 5.003 and 5.004
Changes5.005 Differences between 5.004 and 5.005
[...3076 lines suppressed...]
x2p/a2p.c Output of a2p.y run through byacc
x2p/a2p.h Global declarations
x2p/a2p.pod Pod for awk to perl translator
x2p/a2p.y A yacc grammar for awk
x2p/a2py.c Awk compiler, sort of
x2p/cflags.SH A script that emits C compilation flags per file
x2p/EXTERN.h Same as above
x2p/find2perl.PL A find to perl translator
x2p/hash.c Hashes again
x2p/hash.h Public declarations for the above
x2p/INTERN.h Same as above
x2p/Makefile.SH Precursor to Makefile
x2p/s2p.PL Sed to perl translator
x2p/str.c String handling package
x2p/str.h Public declarations for the above
x2p/util.c Utility routines
x2p/util.h Public declarations for the above
x2p/walk.c Parse tree walker
XSUB.h Include file for extension subroutines
xsutils.c Additional bundled package methods not in UNIVERSAL::
--- NEW FILE: pod.lst ---
# h - Header
# o - Omit from toc
# r - top level READMEs to be copied/symlinked
# a - for auxiliary documentation
# number - indent by
# D - this version's perldelta
# d - copied to this name
h Overview
perl Perl overview (this section)
perlintro Perl introduction for beginners
perltoc Perl documentation table of contents
h Tutorials
perlreftut Perl references short introduction
perldsc Perl data structures intro
perllol Perl data structures: arrays of arrays
perlrequick Perl regular expressions quick start
perlretut Perl regular expressions tutorial
perlboot Perl OO tutorial for beginners
perltoot Perl OO tutorial, part 1
perltooc Perl OO tutorial, part 2
perlbot Perl OO tricks and examples
perlstyle Perl style guide
perlcheat Perl cheat sheet
perltrap Perl traps for the unwary
perldebtut Perl debugging tutorial
perlfaq Perl frequently asked questions
2 perlfaq1 General Questions About Perl
2 perlfaq2 Obtaining and Learning about Perl
2 perlfaq3 Programming Tools
2 perlfaq4 Data Manipulation
2 perlfaq5 Files and Formats
2 perlfaq6 Regexes
2 perlfaq7 Perl Language Issues
2 perlfaq8 System Interaction
2 perlfaq9 Networking
h Reference Manual
perlsyn Perl syntax
perldata Perl data structures
perlop Perl operators and precedence
perlsub Perl subroutines
perlfunc Perl built-in functions
2 perlopentut Perl open() tutorial
2 perlpacktut Perl pack() and unpack() tutorial
perlpod Perl plain old documentation
perlpodspec Perl plain old documentation format specification
perlrun Perl execution and options
perldiag Perl diagnostic messages
perllexwarn Perl warnings and their control
perldebug Perl debugging
perlvar Perl predefined variables
perlre Perl regular expressions, the rest of the story
perlreref Perl regular expressions quick reference
perlref Perl references, the rest of the story
perlform Perl formats
perlobj Perl objects
perltie Perl objects hidden behind simple variables
2 perldbmfilter Perl DBM filters
perlipc Perl interprocess communication
perlfork Perl fork() information
perlnumber Perl number semantics
perlthrtut Perl threads tutorial
2 perlothrtut Old Perl threads tutorial
perlport Perl portability guide
perllocale Perl locale support
perluniintro Perl Unicode introduction
perlunicode Perl Unicode support
perlebcdic Considerations for running Perl on EBCDIC platforms
perlsec Perl security
perlmod Perl modules: how they work
perlmodlib Perl modules: how to write and use
perlmodstyle Perl modules: how to write modules with style
perlmodinstall Perl modules: how to install from CPAN
perlnewmod Perl modules: preparing a new module for distribution
perlutil utilities packaged with the Perl distribution
perlcompile Perl compiler suite intro
perlfilter Perl source filters
perlglossary Perl Glossary
h Internals and C Language Interface
perlembed Perl ways to embed perl in your C or C++ application
perldebguts Perl debugging guts and tips
perlxstut Perl XS tutorial
perlxs Perl XS application programming interface
perlclib Internal replacements for standard C library functions
perlguts Perl internal functions for those doing extensions
perlcall Perl calling conventions from C
perlapi Perl API listing (autogenerated)
perlintern Perl internal functions (autogenerated)
perliol C API for Perl's implementation of IO in Layers
perlapio Perl internal IO abstraction interface
perlhack Perl hackers guide
h Miscellaneous
perlbook Perl book information
perltodo Perl things to do
perldoc Look up Perl documentation in Pod format
perlhist Perl history records
d perldelta Perl changes since previous version
D perl588delta Perl changes in version 5.8.8
perl587delta Perl changes in version 5.8.7
perl586delta Perl changes in version 5.8.6
perl585delta Perl changes in version 5.8.5
perl584delta Perl changes in version 5.8.4
perl583delta Perl changes in version 5.8.3
perl582delta Perl changes in version 5.8.2
perl581delta Perl changes in version 5.8.1
perl58delta Perl changes in version 5.8.0
perl573delta Perl changes in version 5.7.3
perl572delta Perl changes in version 5.7.2
perl571delta Perl changes in version 5.7.1
perl570delta Perl changes in version 5.7.0
perl561delta Perl changes in version 5.6.1
perl56delta Perl changes in version 5.6
perl5005delta Perl changes in version 5.005
perl5004delta Perl changes in version 5.004
perlartistic Perl Artistic License
perlgpl GNU General Public License
ho Language-Specific
ro perlcn Perl for Simplified Chinese (in EUC-CN)
ro perljp Perl for Japanese (in EUC-JP)
ro perlko Perl for Korean (in EUC-KR)
ro perltw Perl for Traditional Chinese (in Big5)
h Platform-Specific
r perlaix Perl notes for AIX
r perlamiga Perl notes for AmigaOS
r perlapollo Perl notes for Apollo DomainOS
r perlbeos Perl notes for BeOS
r perlbs2000 Perl notes for POSIX-BC BS2000
r perlce Perl notes for WinCE
r perlcygwin Perl notes for Cygwin
r perldgux Perl notes for DG/UX
r perldos Perl notes for DOS
r perlepoc Perl notes for EPOC
r perlfreebsd Perl notes for FreeBSD
r perlhpux Perl notes for HP-UX
r perlhurd Perl notes for Hurd
r perlirix Perl notes for Irix
r perllinux Perl notes for Linux
r perlmachten Perl notes for Power MachTen
r perlmacos Perl notes for Mac OS (Classic)
r perlmacosx Perl notes for Mac OS X
r perlmint Perl notes for MiNT
r perlmpeix Perl notes for MPE/iX
r perlnetware Perl notes for NetWare
r perlopenbsd Perl notes for OpenBSD
r perlos2 Perl notes for OS/2
r perlos390 Perl notes for OS/390
r perlos400 Perl notes for OS/400
r perlplan9 Perl notes for Plan 9
r perlqnx Perl notes for QNX
r perlsolaris Perl notes for Solaris
r perltru64 Perl notes for Tru64
r perluts Perl notes for UTS
r perlvmesa Perl notes for VM/ESA
r perlvms Perl notes for VMS
r perlvos Perl notes for Stratus VOS
r perlwin32 Perl notes for Windows
aoh Auxiliary Documentation
ao a2p
ao c2ph
ao dprofpp
ao h2ph
ao h2xs
ao perlbug
ao perldoc
ao pl2pm
ao pod2html
ao pod2man
ao s2p
ao splain
ao xsubpp
--- NEW FILE: README.vms ---
If you read this file _as_is_, just ignore the equal signs on the left.
This file is written in the POD format (see [.POD]PERLPOD.POD;1) which is
specially designed to be readable as is.
=head1 NAME
README.vms - Configuring, building, testing, and installing perl on VMS
=head1 SYNOPSIS
To configure, build, test, and install perl on VMS:
@ Configure
mms
mms test
mms install
mmk may be used in place of mms in the last three steps.
=head1 DESCRIPTION
=head2 Important safety tip
The build and install procedures have changed significantly from the 5.004
releases! Make sure you read the "Configuring the Perl Build", "Building
Perl", and "Installing Perl" sections of this document before you build or
install. Also please note other changes in the current release by having
a look at L<perldelta/VMS>.
Also note that, as of Perl version 5.005 and later, an ANSI C compliant
compiler is required to build Perl. VAX C is *not* ANSI compliant, as it
died a natural death some time before the standard was set. Therefore
VAX C will not compile Perl 5.005 or later. We are sorry about that.
If you are stuck without Compaq (formerly DEC) C consider trying Gnu C
instead, though there have been no recent reports of builds using Gnu C.
There is minimal support for Compaq C++ but this support is not complete;
if you get it working please write to the vmsperl list (for info see
L</"Mailing Lists">).
=head2 Introduction to Perl on VMS
The VMS port of Perl is as functionally complete as any other Perl port
(and as complete as the ports on some Unix systems). The Perl binaries
provide all the Perl system calls that are either available under VMS or
reasonably emulated. There are some incompatibilities in process handling
(e.g. the fork/exec model for creating subprocesses doesn't do what you
might expect under Unix), mainly because VMS and Unix handle processes and
sub-processes very differently.
There are still some unimplemented system functions, and of course we
could use modules implementing useful VMS system services, so if you'd like
to lend a hand we'd love to have you. Join the Perl Porting Team Now!
The current sources and build procedures have been tested on a VAX using
DEC C, and on an AXP using DEC C. If you run into problems with
other compilers, please let us know. (Note: DEC C was renamed to Compaq C
around version 6.2).
There are issues with various versions of DEC C, so if you're not running a
relatively modern version, check the "DEC C issues" section later on in this
document.
=head2 Other required software for Compiling Perl on VMS
In addition to VMS and DCL you will need two things:
=over 4
=item 1 A C compiler.
DEC (now Compaq) C or gcc for VMS (AXP or VAX).
=item 2 A make tool.
DEC's MMS (v2.6 or later), or MadGoat's free MMS
analog MMK (available from ftp.madgoat.com/madgoat) both work
just fine. Gnu Make might work, but it's been so long since
anyone's tested it that we're not sure. MMK is free though, so
go ahead and use that.
=back
=head2 Additional software that is optional for Perl on VMS
You may also want to have on hand:
=over 4
=item 1 GUNZIP/GZIP.EXE for VMS
A de-compressor for *.gz and *.tgz files available from a number
of web/ftp sites and is distributed on the OpenVMS Freeware CD-ROM
from Compaq.
http://www.fsf.org/order/ftp.html
http://www.openvms.compaq.com/freeware/
http://www.crinoid.com/utils/
=item 2 VMS TAR
For reading and writing unix tape archives (*.tar files). Vmstar is also
available from a number of web/ftp sites and is distributed on the OpenVMS
Freeware CD-ROM from Compaq.
ftp://ftp.lp.se/vms/
http://www.openvms.compaq.com/freeware/
Recent versions of VMS tar on ODS-5 volumes may extract tape archive
files with ^. escaped periods in them. See below for further workarounds.
=item 3 UNZIP.EXE for VMS
A combination decompressor and archive reader/writer for *.zip files.
Unzip is available from a number of web/ftp sites.
http://www.info-zip.org/UnZip.html
http://www.openvms.compaq.com/freeware/
ftp://ftp.openvms.compaq.com/
ftp://ftp.madgoat.com/madgoat/
ftp://ftp.process.com/vms-freeware/
=item 4 MOST
Most is an optional pager that is convenient to use with perldoc (unlike
TYPE/PAGE, MOST can go forward and backwards in a document and supports
regular expression searching). Most builds with the slang
library on VMS. Most and slang are available from:
ftp://space.mit.edu/pub/davis/
ftp://ftp.process.com/vms-freeware/narnia/
=item 5 GNU PATCH and DIFFUTILS for VMS
Patches to Perl are usually distributed as GNU unified or contextual diffs.
Such patches are created by the GNU diff program (part of the diffutils
distribution) and applied with GNU patch. VMS ports of these utilities are
available here:
http://www.crinoid.com/utils/
http://www.openvms.compaq.com/freeware/
=back
Please note that UNZIP and GUNZIP are not the same thing (they work with
different formats). Many of the useful files from CPAN (the Comprehensive
Perl Archive Network) are in *.tar.gz or *.tgz format (this includes copies
of the source code for perl as well as modules and scripts that you may
wish to add later) hence you probably want to have GUNZIP.EXE and
VMSTAR.EXE on your VMS machine.
If you want to include socket support, you'll need a TCP/IP stack and either
DEC C, or socket libraries. See the "Socket Support (optional)" topic
for more details.
=head1 Unpacking the Perl source code
You may need to set up a foreign symbol for the unpacking utility of choice.
If you unpack a perl source kit with a name containing multiple periods on
an ODS-5 volume using recent versions of vmstar (e.g. V3.4 or later) you may
need to be especially careful in unpacking the tape archive file. Try to use
the ODS-2 compatability qualifiers such as:
vmstar /extract/verbose/ods2 perl-V^.VIII^.III.tar
or:
vmstar -xvof perl-5^.8^.8.tar
If you neglected to use the /ODS2 qualifier or the -o switch then you
could rename the source directory:
set security/protection=(o:rwed) perl-5^.8^.8.dir
rename perl-5^.8^.8.dir perl-5_8_8.dir
Perl on VMS as of 5.8.8 does not completely handle extended file
parse styles such as are encountered on ODS-5. While it can be built,
installed, and run on ODS-5 filesystems; it may encounter
trouble with characters that are otherwise illegal on ODS-2
volumes (notably the ^. escaped period sequence).
=head1 Configuring the Perl build
To configure perl (a necessary first step), issue the command
@ Configure
from the top of an unpacked perl source directory. You will be asked a
series of questions, and the answers to them (along with the capabilities
of your C compiler and network stack) will determine how perl is custom
built for your machine.
If you have multiple C compilers installed, you'll have your choice of
which one to use. Various older versions of DEC C had some caveats, so if
you're using a version older than 5.2, check the "DEC C Issues" section.
If you have any symbols or logical names in your environment that may
interfere with the build or regression testing of perl then configure.com
will try to warn you about them. If a logical name is causing
you trouble but is in an LNM table that you do not have write access to
then try defining your own to a harmless equivalence string in a table
such that it is resolved before the other (e.g. if TMP is defined in the
SYSTEM table then try DEFINE TMP "NL:" or somesuch in your process table)
otherwise simply deassign the dangerous logical names. The potentially
troublesome logicals and symbols are:
COMP "LOGICAL"
EXT "LOGICAL"
FOO "LOGICAL"
LIB "LOGICAL"
LIST "LOGICAL"
MIME "LOGICAL"
POSIX "LOGICAL"
SYS "LOGICAL"
T "LOGICAL"
THREAD "LOGICAL"
THREADS "LOGICAL"
TIME "LOGICAL"
TMP "LOGICAL"
UNICODE "LOGICAL"
UTIL "LOGICAL"
TEST "SYMBOL"
As a handy shortcut, the command:
@ Configure "-des"
(note the quotation marks and case) will choose reasonable defaults
automatically (it takes DEC C over Gnu C, DEC C sockets over SOCKETSHR
sockets, and either over no sockets). Some options can be given
explicitly on the command line; the following example specifies a
non-default location for where Perl will be installed:
@ Configure "-d" "-Dprefix=dka100:[utils.perl5.]"
Note that the installation location would be by default where you unpacked
the source with a "_ROOT." appended. For example if you unpacked the perl
source into:
DKA200:[PERL-5_10_2...]
Then the PERL_SETUP.COM that gets written out by CONFIGURE.COM will
try to DEFINE your installation PERL_ROOT to be:
DKA200:[PERL-5_10_2_ROOT.]
More help with configure.com is available from:
@ Configure "-h"
See the "Changing compile-time options (optional)" section below to learn
even more details about how to influence the outcome of the important
configuration step. If you find yourself reconfiguring and rebuilding
then be sure to also follow the advice in the "Cleaning up and starting
fresh (optional)" and the checklist of items in the "CAVEATS" sections
below.
=head2 Changing compile-time options (optional) for Perl on VMS
Most of the user definable features of Perl are enabled or disabled in
configure.com, which processes the hints file config_h.SH. There is
code in there to Do The Right Thing, but that may end up being the
wrong thing for you. Make sure you understand what you are doing since
inappropriate changes to configure.com or config_h.SH can render perl
unbuildable; odds are that there's nothing in there you'll need to
change.
The one exception is the various *DIR install locations. Changing those
requires changes in genconfig.pl as well. Be really careful if you need to
change these, as they can cause some fairly subtle problems.
=head2 Socket Support (optional) for Perl on VMS
Perl includes a number of functions for IP sockets, which are available if
you choose to compile Perl with socket support. Since IP networking is an
optional addition to VMS, there are several different IP stacks available.
How well integrated they are into the system depends on the stack, your
version of VMS, and the version of your C compiler.
The most portable solution uses the SOCKETSHR library. In combination with
either UCX or NetLib, this supports all the major TCP stacks (Multinet,
Pathways, TCPWare, UCX, and CMU) on all versions of VMS Perl runs on, with
all the compilers on both VAX and Alpha. The socket interface is also
consistent across versions of VMS and C compilers. It has a problem with
UDP sockets when used with Multinet, though, so you should be aware of
that.
The other solution available is to use the socket routines built into DEC
C. Which routines are available depend on the version of VMS you're
running, and require proper UCX emulation by your TCP/IP vendor.
Relatively current versions of Multinet, TCPWare, Pathway, and UCX all
provide the required libraries--check your manuals or release notes to see
if your version is new enough.
=head1 Building Perl
The configuration script will print out, at the very end, the MMS or MMK
command you need to compile perl. Issue it (exactly as printed) to start
the build.
Once you issue your MMS or MMK command, sit back and wait. Perl should
compile and link without a problem. If a problem does occur check the
"CAVEATS" section of this document. If that does not help send some
mail to the VMSPERL mailing list. Instructions are in the "Mailing Lists"
section of this document.
=head1 Testing Perl
Once Perl has built cleanly you need to test it to make sure things work.
This step is very important since there are always things that can go wrong
somehow and yield a dysfunctional Perl for you.
Testing is very easy, though, as there's a full test suite in the perl
distribution. To run the tests, enter the *exact* MMS line you used to
compile Perl and add the word "test" to the end, like this:
If the compile command was:
MMS
then the test command ought to be:
MMS test
MMS (or MMK) will run all the tests. This may take some time, as there are
a lot of tests. If any tests fail, there will be a note made on-screen.
At the end of all the tests, a summary of the tests, the number passed and
failed, and the time taken will be displayed.
The test driver invoked via MMS TEST has a DCL wrapper ([.VMS]TEST.COM) that
downgrades privileges to NETMBX, TMPMBX for the duration of the test run,
and then restores them to their prior state upon completion of testing.
This is done to ensure that the tests run in a private sandbox and can do no
harm to your system even in the unlikely event something goes badly wrong in
one of the test scripts while running the tests from a privileged account.
A side effect of this safety precaution is that the account used to run the
test suite must be the owner of the directory tree in which Perl has been
built; otherwise the manipulations of temporary files and directories
attempted by some of the tests will fail.
If any tests fail, it means something is wrong with Perl. If the test suite
hangs (some tests can take upwards of two or three minutes, or more if
you're on an especially slow machine, depending on your machine speed, so
don't be hasty), then the test *after* the last one displayed failed. Don't
install Perl unless you're confident that you're OK. Regardless of how
confident you are, make a bug report to the VMSPerl mailing list.
If one or more tests fail, you can get more information on the failure by
issuing this command sequence:
@ [.VMS]TEST .typ "" "-v" [.subdir]test.T
where ".typ" is the file type of the Perl images you just built (if you
didn't do anything special, use .EXE), and "[.subdir]test.T" is the test
that failed. For example, with a normal Perl build, if the test indicated
that t/op/time failed, then you'd do this:
@ [.VMS]TEST .EXE "" "-v" [.OP]TIME.T
Note that test names are reported in UNIX syntax and relative to the
top-level build directory. When supplying them individually to the test
driver, you can use either UNIX or VMS syntax, but you must give the path
relative to the [.T] directory and you must also add the .T extension to the
filename. So, for example if the test lib/Math/Trig fails, you would run:
@ [.VMS]TEST .EXE "" -"v" [-.lib.math]trig.t
When you send in a bug report for failed tests, please include the output
from this command, which is run from the main source directory:
MCR []MINIPERL "-V"
Note that -"V" really is a capital V in double quotes. This will dump out a
couple of screens worth of configuration information, and can help us
diagnose the problem. If (and only if) that did not work then try enclosing
the output of:
MMS printconfig
If (and only if) that did not work then try enclosing the output of:
@ [.vms]myconfig
You may also be asked to provide your C compiler version ("CC/VERSION NL:"
with DEC C, "gcc --version" with GNU CC). To obtain the version of MMS or
MMK you are running try "MMS/ident" or "MMK /ident". The GNU make version
can be identified with "make --version".
=head2 Cleaning up and starting fresh (optional) installing Perl on VMS
If you need to recompile from scratch, you have to make sure you clean up
first. There is a procedure to do it--enter the *exact* MMS line you used
to compile and add "realclean" at the end, like this:
if the compile command was:
MMS
then the cleanup command ought to be:
MMS realclean
If you do not do this things may behave erratically during the subsequent
rebuild attempt. They might not, too, so it is best to be sure and do it.
=head1 Installing Perl
There are several steps you need to take to get Perl installed and
running.
=over 4
=item 1
Check your default file protections with
SHOW PROTECTION /DEFAULT
and adjust if necessary with SET PROTECTION=(code)/DEFAULT.
=item 2
Decide where you want Perl to be installed (unless you have already done so
by using the "prefix" configuration parameter -- see the example in the
"Configuring the Perl build" section).
The DCL script PERL_SETUP.COM that is written by CONFIGURE.COM will help you
with the definition of the PERL_ROOT and PERLSHR logical names and the PERL
foreign command symbol. Take a look at PERL_SETUP.COM and modify it if you
want to. The installation process will execute PERL_SETUP.COM and copy
files to the directory tree pointed to by the PERL_ROOT logical name defined
there, so make sure that you have write access to the parent directory of
what will become the root of your Perl installation.
=item 3
Run the install script via:
MMS install
or
MMK install
If for some reason it complains about target INSTALL being up to date,
throw a /FORCE switch on the MMS or MMK command.
=back
Copy PERL_SETUP.COM to a place accessible to your perl users.
For example:
COPY PERL_SETUP.COM SYS$LIBRARY:
If you want to have everyone on the system have access to perl
then add a line that reads
$ @sys$library:perl_setup
to SYS$MANAGER:SYLOGIN.COM.
Two alternatives to the foreign symbol would be to install PERL into
DCLTABLES.EXE (Check out the section "Installing Perl into DCLTABLES
(optional)" for more information), or put the image in a
directory that's in your DCL$PATH (if you're using VMS V6.2 or higher).
An alternative to having PERL_SETUP.COM define the PERLSHR logical name
is to simply copy it into the system shareable library directory with:
copy perl_root:[000000]perlshr.exe sys$share:
See also the "INSTALLing images (optional)" section.
=head2 Installing Perl into DCLTABLES (optional) on VMS
Execute the following command file to define PERL as a DCL command.
You'll need CMKRNL privilege to install the new dcltables.exe.
$ create perl.cld
!
! modify to reflect location of your perl.exe
!
define verb perl
image perl_root:[000000]perl.exe
cliflags (foreign)
$!
$ set command perl /table=sys$common:[syslib]dcltables.exe -
/output=sys$common:[syslib]dcltables.exe
$ install replace sys$common:[syslib]dcltables.exe
$ exit
=head2 INSTALLing Perl images (optional) on VMS
On systems that are using perl quite a bit, and particularly those with
minimal RAM, you can boost the performance of perl by INSTALLing it as
a known image. PERLSHR.EXE is typically larger than 3000 blocks
and that is a reasonably large amount of IO to load each time perl is
invoked.
INSTALL ADD PERLSHR/SHARE
INSTALL ADD PERL/HEADER
should be enough for PERLSHR.EXE (/share implies /header and /open),
while /HEADER should do for PERL.EXE (perl.exe is not a shared image).
If your code 'use's modules, check to see if there is a shareable image for
them, too. In the base perl build, POSIX, IO, Fcntl, Opcode, SDBM_File,
DCLsym, and Stdio, and other extensions all have shared images that can be
installed /SHARE.
How much of a win depends on your memory situation, but if you are firing
off perl with any regularity (like more than once every 20 seconds or so)
it is probably beneficial to INSTALL at least portions of perl.
While there is code in perl to remove privileges as it runs you are advised
to NOT INSTALL PERL.EXE with PRIVs!
=head2 Running h2ph to create perl header files (optional) on VMS
If using DEC C or Compaq C ensure that you have extracted loose versions
of your compiler's header or *.H files. Be sure to check the contents of:
SYS$LIBRARY:DECC$RTLDEF.TLB
SYS$LIBRARY:SYS$LIB_C.TLB
SYS$LIBRARY:SYS$STARLET_C.TLB
etcetera.
If using GNU cc then also check your GNU_CC:[000000...] tree for the locations
of the GNU cc headers.
=head1 Reporting Bugs
If you come across what you think might be a bug in Perl, please report
it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
the process of creating a bug report. This script includes details of your
installation, and is very handy. Completed bug reports should go to
perlbug at perl.com.
=head1 CAVEATS
Probably the single biggest gotcha in compiling Perl is giving the wrong
switches to MMS/MMK when you build. Use *exactly* what the configure.com
script prints!
The next big gotcha is directory depth. Perl can create directories four,
five, or even six levels deep during the build, so you don't have to be
too deep to start to hit the RMS 8 level limit (for ODS 2 volumes which were
common on versions of VMS prior to V7.2 and even with V7.2 on the VAX).
It is best to do:
DEFINE/TRANS=(CONC,TERM) PERLSRC "disk:[dir.dir.dir.perldir.]"
SET DEFAULT PERLSRC:[000000]
before building in cases where you have to unpack the distribution so deep
(note the trailing period in the definition of PERLSRC). Perl modules
from CPAN can be just as bad (or worse), so watch out for them, too. Perl's
configuration script will warn if it thinks you are too deep (at least on
a VAX or on Alpha versions of VMS prior to 7.2). But MakeMaker will not
warn you if you start out building a module too deep in a directory.
As noted above ODS-5 escape sequences such as ^. can break the perl
build. Solutions include renaming files and directories as needed or
being careful to use the -o switch or /ODS2 qualifier with latter
versions of the vmstar utility when unpacking perl or CPAN modules
on ODS-5 volumes.
Be sure that the process that you use to build perl has a PGFLQ greater
than 100000. Be sure to have a correct local time zone to UTC offset
defined (in seconds) in the logical name SYS$TIMEZONE_DIFFERENTIAL before
running the regression test suite. The SYS$MANAGER:UTC$CONFIGURE_TDF.COM
procedure will help you set that logical for your system but may require
system privileges. For example, a location 5 hours west of UTC (such as
the US East coast while not on daylight savings time) would have:
DEFINE SYS$TIMEZONE_DIFFERENTIAL "-18000"
A final thing that causes trouble is leftover pieces from a failed
build. If things go wrong make sure you do a "(MMK|MMS|make) realclean"
before you rebuild.
=head2 DEC C issues with Perl on VMS
Note to DEC C users: Some early versions (pre-5.2, some pre-4. If you're DEC
C 5.x or higher, with current patches if any, you're fine) of the DECCRTL
contained a few bugs which affect Perl performance:
=over 4
=item - pipes
Newlines are lost on I/O through pipes, causing lines to run together.
This shows up as RMS RTB errors when reading from a pipe. You can
work around this by having one process write data to a file, and
then having the other read the file, instead of the pipe. This is
fixed in version 4 of DEC C.
=item - modf()
The modf() routine returns a non-integral value for some values above
INT_MAX; the Perl "int" operator will return a non-integral value in
these cases. This is fixed in version 4 of DEC C.
=item - ALPACRT ECO
On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine
changes the process default device and directory permanently, even
though the call specified that the change should not persist after
Perl exited. This is fixed by DEC CSC patch ALPACRT04_061 or later.
See also:
http://ftp.support.compaq.com/patches/.new/openvms.shtml
=back
Please note that in later versions "DEC C" may also be known as
"Compaq C".
=head2 GNU issues with Perl on VMS
It has been a while since the GNU utilities such as GCC or GNU make
were used to build perl on VMS. Hence they may require a great deal
of source code modification to work again.
http://slacvx.slac.stanford.edu/HELP/GCC
http://www.progis.de/
http://www.lp.se/products/gnu.html
=head2 Floating Point Considerations
Prior to 5.8.0, Perl simply accepted the default floating point options of the
C compiler, namely representing doubles with D_FLOAT on VAX and G_FLOAT on
Alpha. Single precision floating point values are represented in F_FLOAT
format when either D_FLOAT or G_FLOAT is in use for doubles. Beginning with
5.8.0, Alpha builds now use IEEE floating point formats by default, which in
VMS parlance are S_FLOAT for singles and T_FLOAT for doubles. IEEE is not
available on VAX, so F_FLOAT and D_FLOAT remain the defaults for singles and
doubles respectively. The available non-default options are G_FLOAT on VAX
and D_FLOAT or G_FLOAT on Alpha.
The use of IEEE on Alpha introduces NaN, infinity, and denormalization
capabilities not available with D_FLOAT and G_FLOAT. When using one of those
non-IEEE formats, silent underflow and overflow are emulated in the conversion
of strings to numbers, but it is preferable to get the real thing by using
IEEE where possible.
Regardless of what floating point format you consider preferable, be aware
that the choice may have an impact on compatibility with external libraries,
such as database interfaces, and with existing data, such as data created with
the C<pack> function and written to disk, or data stored via the Storable
extension. For example, a C<pack("d", $foo)")> will create a D_FLOAT,
G_FLOAT, or T_FLOAT depending on what your Perl was configured with. When
written to disk, the value can only be retrieved later by a Perl configured
with the same floating point option that was in effect when it was created.
To obtain a non-IEEE build on Alpha, simply answer no to the "Use IEEE math?"
question during the configuration. To obtain an option different from the C
compiler default on either VAX or Alpha, put in the option that you want in
answer to the "Any additional cc flags?" question. For example, to obtain a
G_FLOAT build on VAX, put in C</FLOAT=G_FLOAT>.
=head2 Multinet issues with Perl on VMS
Prior to the release of Perl 5.8.0 it was noted that the regression
test for lib/Net/hostent (in file [.lib.Net]hostent.t) will fail owing
to problems with the hostent structure returned by C calls to either
gethostbyname() or gethostbyaddr() using DEC or Compaq C with a
Multinet TCP/IP stack. The problem was noted in Multinet 4.3A
using either Compaq C 6.5 or DEC C 6.0, and with Multinet 4.2A
using DEC C 5.2, but could easily affect other versions of Multinet.
Process Software Inc. has acknowledged a bug in the Multinet version
of UCX$IPC_SHR and has provided an ECO for it. The ECO is called
UCX_LIBRARY_EMULATION-010_A044 and is available from:
http://www.multinet.process.com/eco.html
As of this writing, the ECO is only available for Multinet versions
4.3A and later. You may determine the version of Multinet that you
are running using the command:
multinet show /version
from the DCL command prompt.
If the ECO is unavailable for your version of Multinet and you are
unable to upgrade, you might try using Perl programming constructs
such as:
$address = substr($gethostbyname_addr,0,4);
to temporarily work around the problem, or if you are brave
and do not mind the possibility of breaking IPv6 addresses,
you might modify the pp_sys.c file to add an ad-hoc correction
like so:
--- pp_sys.c;1 Thu May 30 14:42:17 2002
+++ pp_sys.c Thu May 30 12:54:02 2002
@@ -4684,6 +4684,10 @@
}
#endif
+ if (hent) {
+ hent->h_length = 4;
+ }
+
if (GIMME != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (hent) {
then re-compile and re-test your perl. After the installation
of the Multinet ECO you ought to back out any such changes though.
=head1 Mailing Lists
There are several mailing lists available to the Perl porter. For VMS
specific issues (including both Perl questions and installation problems)
there is the VMSPERL mailing list. It is usually a low-volume (10-12
messages a week) mailing list.
To subscribe, send a mail message to VMSPERL-SUBSCRIBE at PERL.ORG. The VMSPERL
mailing list address is VMSPERL at PERL.ORG. Any mail sent there gets echoed
to all subscribers of the list. There is a searchable archive of the list
on the web at:
http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/
To unsubscribe from VMSPERL send a message to VMSPERL-UNSUBSCRIBE at PERL.ORG.
Be sure to do so from the subscribed account that you are canceling.
=head2 Web sites for Perl on VMS
Vmsperl pages on the web include:
http://www.sidhe.org/vmsperl/index.html
http://www.crinoid.com/
http://duphy4.physics.drexel.edu/pub/cgi_info.htmlx
http://www.cpan.org/modules/by-module/VMS/
http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/
http://www.best.com/~pvhp/vms/
http://www-ang.kfunigraz.ac.at/~binder/perl.html
http://lists.perl.org/showlist.cgi?name=vmsperl
http://archive.develooper.com/vmsperl@perl.org/
http://www.openvms.compaq.com/openvms/products/ips/apache/csws_modperl.html
=head1 SEE ALSO
Perl information for users and programmers about the port of perl to VMS is
available from the [.VMS]PERLVMS.POD file that gets installed as L<perlvms>.
For administrators the perlvms document also includes a detailed discussion
of extending vmsperl with CPAN modules after Perl has been installed.
=head1 AUTHORS
Revised 10-October-2001 by Craig Berry craigberry at mac.com.
Revised 25-February-2000 by Peter Prymmer pvhp at best.com.
Revised 27-October-1999 by Craig Berry craigberry at mac.com.
Revised 01-March-1999 by Dan Sugalski dan at sidhe.org.
Originally by Charles Bailey bailey at newman.upenn.edu.
=head1 ACKNOWLEDGEMENTS
A real big thanks needs to go to Charles Bailey
bailey at newman.upenn.edu, who is ultimately responsible for Perl 5.004
running on VMS. Without him, nothing the rest of us have done would be at
all important.
There are, of course, far too many people involved in the porting and testing
of Perl to mention everyone who deserves it, so please forgive us if we've
missed someone. That said, special thanks are due to the following:
Tim Adye T.J.Adye at rl.ac.uk
for the VMS emulations of getpw*()
David Denholm denholm at conmat.phys.soton.ac.uk
for extensive testing and provision of pipe and SocketShr code,
Mark Pizzolato mark at infocomm.com
for the getredirection() code
Rich Salz rsalz at bbn.com
for readdir() and related routines
Peter Prymmer pvhp at best.com
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
Dan Sugalski dan at sidhe.org
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
the opportunity to test and develop for the AXP,
John Hasstedt John.Hasstedt at sunysb.edu
for VAX VMS V7.2 support
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
gratitude is due to Larry Wall larry at wall.org, for having the ideas which
have made our sleepless nights possible.
Thanks,
The VMSperl group
=cut
--- NEW FILE: regexec.c ---
/* regexec.c
*/
/*
* "One Ring to rule them all, One Ring to find them..."
*/
/* This file contains functions for executing a regular expression. See
* also regcomp.c which funnily enough, contains functions for compiling
* a regular expression.
*
* This file is also copied at build time to ext/re/re_exec.c, where
* it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
* This causes the main functions to be compiled under new names and with
* debugging support added, which makes "use re 'debug'" work.
*/
/* NOTE: this is derived from Henry Spencer's regexp code, and should not
[...4613 lines suppressed...]
if (SvTAIL(prog->anchored_utf8))
SvTAIL_on(sv);
} else {
SvREFCNT_dec(sv);
prog->anchored_substr = sv = &PL_sv_undef;
}
if (prog->anchored_utf8 == prog->check_utf8)
prog->check_substr = sv;
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: XSUB.h ---
/* XSUB.h
*
* Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifndef _INC_PERL_XSUB_H
#define _INC_PERL_XSUB_H 1
/* first, some documentation for xsubpp-generated items */
/*
=head1 Variables created by C<xsubpp> and C<xsubpp> internal functions
=for apidoc Amn|char*|CLASS
Variable which is setup by C<xsubpp> to indicate the
class name for a C++ XS constructor. This is always a C<char*>. See C<THIS>.
=for apidoc Amn|(whatever)|RETVAL
Variable which is setup by C<xsubpp> to hold the return value for an
XSUB. This is always the proper type for the XSUB. See
L<perlxs/"The RETVAL Variable">.
=for apidoc Amn|(whatever)|THIS
Variable which is setup by C<xsubpp> to designate the object in a C++
XSUB. This is always the proper type for the C++ object. See C<CLASS> and
L<perlxs/"Using XS With C++">.
=for apidoc Amn|I32|ax
Variable which is setup by C<xsubpp> to indicate the stack base offset,
used by the C<ST>, C<XSprePUSH> and C<XSRETURN> macros. The C<dMARK> macro
must be called prior to setup the C<MARK> variable.
=for apidoc Amn|I32|items
Variable which is setup by C<xsubpp> to indicate the number of
items on the stack. See L<perlxs/"Variable-length Parameter Lists">.
=for apidoc Amn|I32|ix
Variable which is setup by C<xsubpp> to indicate which of an
XSUB's aliases was used to invoke it. See L<perlxs/"The ALIAS: Keyword">.
=for apidoc Am|SV*|ST|int ix
Used to access elements on the XSUB's stack.
=for apidoc AmU||XS
Macro to declare an XSUB and its C parameter list. This is handled by
C<xsubpp>.
=for apidoc Ams||dAX
Sets up the C<ax> variable.
This is usually handled automatically by C<xsubpp> by calling C<dXSARGS>.
=for apidoc Ams||dAXMARK
Sets up the C<ax> variable and stack marker variable C<mark>.
This is usually handled automatically by C<xsubpp> by calling C<dXSARGS>.
=for apidoc Ams||dITEMS
Sets up the C<items> variable.
This is usually handled automatically by C<xsubpp> by calling C<dXSARGS>.
=for apidoc Ams||dXSARGS
Sets up stack and mark pointers for an XSUB, calling dSP and dMARK.
Sets up the C<ax> and C<items> variables by calling C<dAX> and C<dITEMS>.
This is usually handled automatically by C<xsubpp>.
=for apidoc Ams||dXSI32
Sets up the C<ix> variable for an XSUB which has aliases. This is usually
handled automatically by C<xsubpp>.
=cut
*/
#ifndef PERL_UNUSED_ARG
# ifdef lint
# include <note.h>
# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
# else
# define PERL_UNUSED_ARG(x) ((void)x)
# endif
#endif
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(x) ((void)x)
#endif
#define ST(off) PL_stack_base[ax + (off)]
#if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
# define XS(name) __declspec(dllexport) void name(pTHX_ CV* cv)
#else
# ifdef HASATTRIBUTE_UNUSED
# define XS(name) void name(pTHX_ CV* cv __attribute__unused__)
# else
# define XS(name) void name(pTHX_ CV* cv)
# endif
#endif
#define dAX const I32 ax = MARK - PL_stack_base + 1
#define dAXMARK \
I32 ax = POPMARK; \
register SV **mark = PL_stack_base + ax++
#define dITEMS I32 items = SP - MARK
#ifdef lint
# define dXSARGS \
NOTE(ARGUNUSED(cv)) \
dSP; dAXMARK; dITEMS
#else
# define dXSARGS \
dSP; dAXMARK; dITEMS
#endif
#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
? PAD_SV(PL_op->op_targ) : sv_newmortal())
/* Should be used before final PUSHi etc. if not in PPCODE section. */
#define XSprePUSH (sp = PL_stack_base + ax - 1)
#define XSANY CvXSUBANY(cv)
#define dXSI32 I32 ix = XSANY.any_i32
#ifdef __cplusplus
# define XSINTERFACE_CVT(ret,name) ret (*name)(...)
#else
# define XSINTERFACE_CVT(ret,name) ret (*name)()
#endif
#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION)
#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT(ret,))(f))
#define XSINTERFACE_FUNC_SET(cv,f) \
CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f)
/* Simple macros to put new mortal values onto the stack. */
/* Typically used to return values from XS functions. */
/*
=head1 Stack Manipulation Macros
=for apidoc Am|void|XST_mIV|int pos|IV iv
Place an integer into the specified position C<pos> on the stack. The
value is stored in a new mortal SV.
=for apidoc Am|void|XST_mNV|int pos|NV nv
Place a double into the specified position C<pos> on the stack. The value
is stored in a new mortal SV.
=for apidoc Am|void|XST_mPV|int pos|char* str
Place a copy of a string into the specified position C<pos> on the stack.
The value is stored in a new mortal SV.
=for apidoc Am|void|XST_mNO|int pos
Place C<&PL_sv_no> into the specified position C<pos> on the
stack.
=for apidoc Am|void|XST_mYES|int pos
Place C<&PL_sv_yes> into the specified position C<pos> on the
stack.
=for apidoc Am|void|XST_mUNDEF|int pos
Place C<&PL_sv_undef> into the specified position C<pos> on the
stack.
=for apidoc Am|void|XSRETURN|int nitems
Return from XSUB, indicating number of items on the stack. This is usually
handled by C<xsubpp>.
=for apidoc Am|void|XSRETURN_IV|IV iv
Return an integer from an XSUB immediately. Uses C<XST_mIV>.
=for apidoc Am|void|XSRETURN_UV|IV uv
Return an integer from an XSUB immediately. Uses C<XST_mUV>.
=for apidoc Am|void|XSRETURN_NV|NV nv
Return a double from an XSUB immediately. Uses C<XST_mNV>.
=for apidoc Am|void|XSRETURN_PV|char* str
Return a copy of a string from an XSUB immediately. Uses C<XST_mPV>.
=for apidoc Ams||XSRETURN_NO
Return C<&PL_sv_no> from an XSUB immediately. Uses C<XST_mNO>.
=for apidoc Ams||XSRETURN_YES
Return C<&PL_sv_yes> from an XSUB immediately. Uses C<XST_mYES>.
=for apidoc Ams||XSRETURN_UNDEF
Return C<&PL_sv_undef> from an XSUB immediately. Uses C<XST_mUNDEF>.
=for apidoc Ams||XSRETURN_EMPTY
Return an empty list from an XSUB immediately.
=head1 Variables created by C<xsubpp> and C<xsubpp> internal functions
=for apidoc AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto
Used by C<xsubpp> to hook up XSUBs as Perl subs. Adds Perl prototypes to
the subs.
=for apidoc AmU||XS_VERSION
The version identifier for an XS module. This is usually
handled automatically by C<ExtUtils::MakeMaker>. See C<XS_VERSION_BOOTCHECK>.
=for apidoc Ams||XS_VERSION_BOOTCHECK
Macro to verify that a PM module's $VERSION variable matches the XS
module's C<XS_VERSION> variable. This is usually handled automatically by
C<xsubpp>. See L<perlxs/"The VERSIONCHECK: Keyword">.
=cut
*/
#define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) )
#define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
#define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) )
#define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0)))
#define XST_mPVN(i,v,n) (ST(i) = sv_2mortal(newSVpvn(v,n)))
#define XST_mNO(i) (ST(i) = &PL_sv_no )
#define XST_mYES(i) (ST(i) = &PL_sv_yes )
#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef)
#define XSRETURN(off) \
STMT_START { \
IV tmpXSoff = (off); \
PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); \
return; \
} STMT_END
#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END
#define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END
#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v); XSRETURN(1); } STMT_END
#define XSRETURN_PVN(v,n) STMT_START { XST_mPVN(0,v,n); XSRETURN(1); } STMT_END
#define XSRETURN_NO STMT_START { XST_mNO(0); XSRETURN(1); } STMT_END
#define XSRETURN_YES STMT_START { XST_mYES(0); XSRETURN(1); } STMT_END
#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END
#define XSRETURN_EMPTY STMT_START { XSRETURN(0); } STMT_END
#define newXSproto(a,b,c,d) sv_setpv((SV*)newXS(a,b,c), d)
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
SV *_sv; \
const char *vn = Nullch, *module = SvPV_nolen_const(ST(0)); \
if (items >= 2) /* version supplied as bootstrap arg */ \
_sv = ST(1); \
else { \
/* XXX GV_ADDWARN */ \
_sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \
vn = "XS_VERSION"), FALSE); \
if (!_sv || !SvOK(_sv)) \
_sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
if (_sv && (!SvOK(_sv) || strNE(XS_VERSION, SvPV_nolen_const(_sv)))) \
Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,\
module, XS_VERSION, \
vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
vn ? vn : "bootstrap parameter", _sv); \
} STMT_END
#else
# define XS_VERSION_BOOTCHECK
#endif
/*
The DBM_setFilter & DBM_ckFilter macros are only used by
the *DB*_File modules
*/
#define DBM_setFilter(db_type,code) \
{ \
if (db_type) \
RETVAL = sv_mortalcopy(db_type) ; \
ST(0) = RETVAL ; \
if (db_type && (code == &PL_sv_undef)) { \
SvREFCNT_dec(db_type) ; \
db_type = NULL ; \
} \
else if (code) { \
if (db_type) \
sv_setsv(db_type, code) ; \
else \
db_type = newSVsv(code) ; \
} \
}
#define DBM_ckFilter(arg,type,name) \
if (db->type) { \
if (db->filtering) { \
croak("recursion detected in %s", name) ; \
} \
ENTER ; \
SAVETMPS ; \
SAVEINT(db->filtering) ; \
db->filtering = TRUE ; \
SAVESPTR(DEFSV) ; \
if (name[7] == 's') \
arg = newSVsv(arg); \
DEFSV = arg ; \
SvTEMP_off(arg) ; \
PUSHMARK(SP) ; \
PUTBACK ; \
(void) perl_call_sv(db->type, G_DISCARD); \
SPAGAIN ; \
PUTBACK ; \
FREETMPS ; \
LEAVE ; \
if (name[7] == 's'){ \
arg = sv_2mortal(arg); \
} \
SvOKp(arg); \
}
#if 1 /* for compatibility */
# define VTBL_sv &PL_vtbl_sv
# define VTBL_env &PL_vtbl_env
# define VTBL_envelem &PL_vtbl_envelem
# define VTBL_sig &PL_vtbl_sig
# define VTBL_sigelem &PL_vtbl_sigelem
# define VTBL_pack &PL_vtbl_pack
# define VTBL_packelem &PL_vtbl_packelem
# define VTBL_dbline &PL_vtbl_dbline
# define VTBL_isa &PL_vtbl_isa
# define VTBL_isaelem &PL_vtbl_isaelem
# define VTBL_arylen &PL_vtbl_arylen
# define VTBL_glob &PL_vtbl_glob
# define VTBL_mglob &PL_vtbl_mglob
# define VTBL_nkeys &PL_vtbl_nkeys
# define VTBL_taint &PL_vtbl_taint
# define VTBL_substr &PL_vtbl_substr
# define VTBL_vec &PL_vtbl_vec
# define VTBL_pos &PL_vtbl_pos
# define VTBL_bm &PL_vtbl_bm
# define VTBL_fm &PL_vtbl_fm
# define VTBL_uvar &PL_vtbl_uvar
# define VTBL_defelem &PL_vtbl_defelem
# define VTBL_regexp &PL_vtbl_regexp
# define VTBL_regdata &PL_vtbl_regdata
# define VTBL_regdatum &PL_vtbl_regdatum
# ifdef USE_LOCALE_COLLATE
# define VTBL_collxfrm &PL_vtbl_collxfrm
# endif
# define VTBL_amagic &PL_vtbl_amagic
# define VTBL_amagicelem &PL_vtbl_amagicelem
#endif
#include "perlapi.h"
#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE)
# undef aTHX
# undef aTHX_
# define aTHX PERL_GET_THX
# define aTHX_ aTHX,
#endif
#if defined(PERL_IMPLICIT_SYS) && !defined(PERL_CORE)
# ifndef NO_XSLOCKS
# if defined (NETWARE) && defined (USE_STDIO)
# define times PerlProc_times
# define setuid PerlProc_setuid
# define setgid PerlProc_setgid
# define getpid PerlProc_getpid
# define pause PerlProc_pause
# define exit PerlProc_exit
# define _exit PerlProc__exit
# else
# undef closedir
# undef opendir
# undef stdin
# undef stdout
# undef stderr
# undef feof
# undef ferror
# undef fgetpos
# undef ioctl
# undef getlogin
# undef setjmp
# undef getc
# undef ungetc
# undef fileno
/* Following symbols were giving redefinition errors while building extensions - sgp 17th Oct 2000 */
#ifdef NETWARE
# undef readdir
# undef fstat
# undef stat
# undef longjmp
# undef endhostent
# undef endnetent
# undef endprotoent
# undef endservent
# undef gethostbyaddr
# undef gethostbyname
# undef gethostent
# undef getnetbyaddr
# undef getnetbyname
# undef getnetent
# undef getprotobyname
# undef getprotobynumber
# undef getprotoent
# undef getservbyname
# undef getservbyport
# undef getservent
# undef inet_ntoa
# undef sethostent
# undef setnetent
# undef setprotoent
# undef setservent
#endif /* NETWARE */
# undef socketpair
# define mkdir PerlDir_mkdir
# define chdir PerlDir_chdir
# define rmdir PerlDir_rmdir
# define closedir PerlDir_close
# define opendir PerlDir_open
# define readdir PerlDir_read
# define rewinddir PerlDir_rewind
# define seekdir PerlDir_seek
# define telldir PerlDir_tell
# define putenv PerlEnv_putenv
# define getenv PerlEnv_getenv
# define uname PerlEnv_uname
# define stdin PerlSIO_stdin
# define stdout PerlSIO_stdout
# define stderr PerlSIO_stderr
# define fopen PerlSIO_fopen
# define fclose PerlSIO_fclose
# define feof PerlSIO_feof
# define ferror PerlSIO_ferror
# define clearerr PerlSIO_clearerr
# define getc PerlSIO_getc
# define fputc PerlSIO_fputc
# define fputs PerlSIO_fputs
# define fflush PerlSIO_fflush
# define ungetc PerlSIO_ungetc
# define fileno PerlSIO_fileno
# define fdopen PerlSIO_fdopen
# define freopen PerlSIO_freopen
# define fread PerlSIO_fread
# define fwrite PerlSIO_fwrite
# define setbuf PerlSIO_setbuf
# define setvbuf PerlSIO_setvbuf
# define setlinebuf PerlSIO_setlinebuf
# define stdoutf PerlSIO_stdoutf
# define vfprintf PerlSIO_vprintf
# define ftell PerlSIO_ftell
# define fseek PerlSIO_fseek
# define fgetpos PerlSIO_fgetpos
# define fsetpos PerlSIO_fsetpos
# define frewind PerlSIO_rewind
# define tmpfile PerlSIO_tmpfile
# define access PerlLIO_access
# define chmod PerlLIO_chmod
# define chsize PerlLIO_chsize
# define close PerlLIO_close
# define dup PerlLIO_dup
# define dup2 PerlLIO_dup2
# define flock PerlLIO_flock
# define fstat PerlLIO_fstat
# define ioctl PerlLIO_ioctl
# define isatty PerlLIO_isatty
# define link PerlLIO_link
# define lseek PerlLIO_lseek
# define lstat PerlLIO_lstat
# define mktemp PerlLIO_mktemp
# define open PerlLIO_open
# define read PerlLIO_read
# define rename PerlLIO_rename
# define setmode PerlLIO_setmode
# define stat(buf,sb) PerlLIO_stat(buf,sb)
# define tmpnam PerlLIO_tmpnam
# define umask PerlLIO_umask
# define unlink PerlLIO_unlink
# define utime PerlLIO_utime
# define write PerlLIO_write
# define malloc PerlMem_malloc
# define realloc PerlMem_realloc
# define free PerlMem_free
# define abort PerlProc_abort
# define exit PerlProc_exit
# define _exit PerlProc__exit
# define execl PerlProc_execl
# define execv PerlProc_execv
# define execvp PerlProc_execvp
# define getuid PerlProc_getuid
# define geteuid PerlProc_geteuid
# define getgid PerlProc_getgid
# define getegid PerlProc_getegid
# define getlogin PerlProc_getlogin
# define kill PerlProc_kill
# define killpg PerlProc_killpg
# define pause PerlProc_pause
# define popen PerlProc_popen
# define pclose PerlProc_pclose
# define pipe PerlProc_pipe
# define setuid PerlProc_setuid
# define setgid PerlProc_setgid
# define sleep PerlProc_sleep
# define times PerlProc_times
# define wait PerlProc_wait
# define setjmp PerlProc_setjmp
# define longjmp PerlProc_longjmp
# define signal PerlProc_signal
# define getpid PerlProc_getpid
# define gettimeofday PerlProc_gettimeofday
# define htonl PerlSock_htonl
# define htons PerlSock_htons
# define ntohl PerlSock_ntohl
# define ntohs PerlSock_ntohs
# define accept PerlSock_accept
# define bind PerlSock_bind
# define connect PerlSock_connect
# define endhostent PerlSock_endhostent
# define endnetent PerlSock_endnetent
# define endprotoent PerlSock_endprotoent
# define endservent PerlSock_endservent
# define gethostbyaddr PerlSock_gethostbyaddr
# define gethostbyname PerlSock_gethostbyname
# define gethostent PerlSock_gethostent
# define gethostname PerlSock_gethostname
# define getnetbyaddr PerlSock_getnetbyaddr
# define getnetbyname PerlSock_getnetbyname
# define getnetent PerlSock_getnetent
# define getpeername PerlSock_getpeername
# define getprotobyname PerlSock_getprotobyname
# define getprotobynumber PerlSock_getprotobynumber
# define getprotoent PerlSock_getprotoent
# define getservbyname PerlSock_getservbyname
# define getservbyport PerlSock_getservbyport
# define getservent PerlSock_getservent
# define getsockname PerlSock_getsockname
# define getsockopt PerlSock_getsockopt
# define inet_addr PerlSock_inet_addr
# define inet_ntoa PerlSock_inet_ntoa
# define listen PerlSock_listen
# define recv PerlSock_recv
# define recvfrom PerlSock_recvfrom
# define select PerlSock_select
# define send PerlSock_send
# define sendto PerlSock_sendto
# define sethostent PerlSock_sethostent
# define setnetent PerlSock_setnetent
# define setprotoent PerlSock_setprotoent
# define setservent PerlSock_setservent
# define setsockopt PerlSock_setsockopt
# define shutdown PerlSock_shutdown
# define socket PerlSock_socket
# define socketpair PerlSock_socketpair
# endif /* NETWARE && USE_STDIO */
# ifdef USE_SOCKETS_AS_HANDLES
# undef fd_set
# undef FD_SET
# undef FD_CLR
# undef FD_ISSET
# undef FD_ZERO
# define fd_set Perl_fd_set
# define FD_SET(n,p) PERL_FD_SET(n,p)
# define FD_CLR(n,p) PERL_FD_CLR(n,p)
# define FD_ISSET(n,p) PERL_FD_ISSET(n,p)
# define FD_ZERO(p) PERL_FD_ZERO(p)
# endif /* USE_SOCKETS_AS_HANDLES */
# endif /* NO_XSLOCKS */
#endif /* PERL_IMPLICIT_SYS && !PERL_CORE */
#endif /* _INC_PERL_XSUB_H */ /* include guard */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.os390 ---
This document is written in pod format hence there are punctuation
characters in odd places. Do not worry, you've apparently got the
ASCII->EBCDIC translation worked out correctly. You can read more
about pod in pod/perlpod.pod or the short summary in the INSTALL file.
=head1 NAME
README.os390 - building and installing Perl for OS/390 and z/OS
=head1 SYNOPSIS
This document will help you Configure, build, test and install Perl
on OS/390 (aka z/OS) Unix System Services.
=head1 DESCRIPTION
This is a fully ported Perl for OS/390 Version 2 Release 3, 5, 6, 7,
8, and 9. It may work on other versions or releases, but those are
the ones we've tested it on.
You may need to carry out some system configuration tasks before
running the Configure script for Perl.
=head2 Tools
The z/OS Unix Tools and Toys list may prove helpful and contains links
to ports of much of the software helpful for building Perl.
http://www-1.ibm.com/servers/eserver/zseries/zos/unix/bpxa1toy.html
=head2 Unpacking Perl distribution on OS/390
If using ftp remember to transfer the distribution in binary format.
Gunzip/gzip for OS/390 is discussed at:
http://www-1.ibm.com/servers/eserver/zseries/zos/unix/faq/bpxqp1.html
to extract an ASCII tar archive on OS/390, try this:
pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar
or
zcat latest.tar.Z | pax -o to=IBM-1047,from=ISO8859-1 -r
If you get lots of errors of the form
tar: FSUM7171 ...: cannot set uid/gid: EDC5139I Operation not permitted.
you didn't read the above and tried to use tar instead of pax, you'll
first have to remove the (now corrupt) perl directory
rm -rf perl-...
and then use pax.
=head2 Setup and utilities for Perl on OS/390
Be sure that your yacc installation is in place including any necessary
parser template files. If you have not already done so then be sure to:
cp /samples/yyparse.c /etc
This may also be a good time to ensure that your /etc/protocol file
and either your /etc/resolv.conf or /etc/hosts files are in place.
The IBM document that described such USS system setup issues was
SC28-1890-07 "OS/390 UNIX System Services Planning", in particular
Chapter 6 on customizing the OE shell.
GNU make for OS/390, which is recommended for the build of perl (as
well as building CPAN modules and extensions), is available from the
L</Tools>.
Some people have reported encountering "Out of memory!" errors while
trying to build Perl using GNU make binaries. If you encounter such
trouble then try to download the source code kit and build GNU make
from source to eliminate any such trouble. You might also find GNU make
(as well as Perl and Apache) in the red-piece/book "Open Source Software
for OS/390 UNIX", SG24-5944-00 from IBM.
If instead of the recommended GNU make you would like to use the system
supplied make program then be sure to install the default rules file
properly via the shell command:
cp /samples/startup.mk /etc
and be sure to also set the environment variable _C89_CCMODE=1 (exporting
_C89_CCMODE=1 is also a good idea for users of GNU make).
You might also want to have GNU groff for OS/390 installed before
running the "make install" step for Perl.
There is a syntax error in the /usr/include/sys/socket.h header file
that IBM supplies with USS V2R7, V2R8, and possibly V2R9. The problem with
the header file is that near the definition of the SO_REUSEPORT constant
there is a spurious extra '/' character outside of a comment like so:
#define SO_REUSEPORT 0x0200 /* allow local address & port
reuse */ /
You could edit that header yourself to remove that last '/', or you might
note that Language Environment (LE) APAR PQ39997 describes the problem
and PTF's UQ46272 and UQ46271 are the (R8 at least) fixes and apply them.
If left unattended that syntax error will turn up as an inability for Perl
to build its "Socket" extension.
For successful testing you may need to turn on the sticky bit for your
world readable /tmp directory if you have not already done so (see man chmod).
=head2 Configure Perl on OS/390
Once you've unpacked the distribution, run "sh Configure" (see INSTALL
for a full discussion of the Configure options). There is a "hints" file
for os390 that specifies the correct values for most things. Some things
to watch out for include:
=over 4
=item *
A message of the form:
(I see you are using the Korn shell. Some ksh's blow up on Configure,
mainly on older exotic systems. If yours does, try the Bourne shell instead.)
is nothing to worry about at all.
=item *
Some of the parser default template files in /samples are needed in /etc.
In particular be sure that you at least copy /samples/yyparse.c to /etc
before running Perl's Configure. This step ensures successful extraction
of EBCDIC versions of parser files such as perly.c, perly.h, and x2p/a2p.c.
This has to be done before running Configure the first time. If you failed
to do so then the easiest way to re-Configure Perl is to delete your
misconfigured build root and re-extract the source from the tar ball.
Then you must ensure that /etc/yyparse.c is properly in place before
attempting to re-run Configure.
=item *
This port will support dynamic loading, but it is not selected by
default. If you would like to experiment with dynamic loading then
be sure to specify -Dusedl in the arguments to the Configure script.
See the comments in hints/os390.sh for more information on dynamic loading.
If you build with dynamic loading then you will need to add the
$archlibexp/CORE directory to your LIBPATH environment variable in order
for perl to work. See the config.sh file for the value of $archlibexp.
If in trying to use Perl you see an error message similar to:
CEE3501S The module libperl.dll was not found.
From entry point __dllstaticinit at compile unit offset +00000194 at
then your LIBPATH does not have the location of libperl.x and either
libperl.dll or libperl.so in it. Add that directory to your LIBPATH and
proceed.
=item *
Do not turn on the compiler optimization flag "-O". There is
a bug in either the optimizer or perl that causes perl to
not work correctly when the optimizer is on.
=item *
Some of the configuration files in /etc used by the
networking APIs are either missing or have the wrong
names. In particular, make sure that there's either
an /etc/resolv.conf or an /etc/hosts, so that
gethostbyname() works, and make sure that the file
/etc/proto has been renamed to /etc/protocol (NOT
/etc/protocols, as used by other Unix systems).
You may have to look for things like HOSTNAME and DOMAINORIGIN
in the "//'SYS1.TCPPARMS(TCPDATA)'" PDS member in order to
properly set up your /etc networking files.
=back
=head2 Build, Test, Install Perl on OS/390
Simply put:
sh Configure
make
make test
if everything looks ok (see the next section for test/IVP diagnosis) then:
make install
this last step may or may not require UID=0 privileges depending
on how you answered the questions that Configure asked and whether
or not you have write access to the directories you specified.
=head2 Build Anomalies with Perl on OS/390
"Out of memory!" messages during the build of Perl are most often fixed
by re building the GNU make utility for OS/390 from a source code kit.
Another memory limiting item to check is your MAXASSIZE parameter in your
'SYS1.PARMLIB(BPXPRMxx)' data set (note too that as of V2R8 address space
limits can be set on a per user ID basis in the USS segment of a RACF
profile). People have reported successful builds of Perl with MAXASSIZE
parameters as small as 503316480 (and it may be possible to build Perl
with a MAXASSIZE smaller than that).
Within USS your /etc/profile or $HOME/.profile may limit your ulimit
settings. Check that the following command returns reasonable values:
ulimit -a
To conserve memory you should have your compiler modules loaded into the
Link Pack Area (LPA/ELPA) rather than in a link list or step lib.
If the c89 compiler complains of syntax errors during the build of the
Socket extension then be sure to fix the syntax error in the system
header /usr/include/sys/socket.h.
=head2 Testing Anomalies with Perl on OS/390
The "make test" step runs a Perl Verification Procedure, usually before
installation. You might encounter STDERR messages even during a successful
run of "make test". Here is a guide to some of the more commonly seen
anomalies:
=over 4
=item *
A message of the form:
comp/cpp.............ERROR CBC3191 ./.301989890.c:1 The character $ is not a
valid C source character.
FSUM3065 The COMPILE step ended with return code 12.
FSUM3017 Could not compile .301989890.c. Correct the errors and try again.
ok
indicates that the t/comp/cpp.t test of Perl's -P command line switch has
passed but that the particular invocation of c89 -E in the cpp script does
not suppress the C compiler check of source code validity.
=item *
A message of the form:
io/openpid...........CEE5210S The signal SIGHUP was received.
CEE5210S The signal SIGHUP was received.
CEE5210S The signal SIGHUP was received.
ok
indicates that the t/io/openpid.t test of Perl has passed but done so
with extraneous messages on stderr from CEE.
=item *
A message of the form:
lib/ftmp-security....File::Temp::_gettemp: Parent directory (/tmp/) is not safe
(sticky bit not set when world writable?) at lib/ftmp-security.t line 100
File::Temp::_gettemp: Parent directory (/tmp/) is not safe (sticky bit not
set when world writable?) at lib/ftmp-security.t line 100
ok
indicates a problem with the permissions on your /tmp directory within the HFS.
To correct that problem issue the command:
chmod a+t /tmp
from an account with write access to the directory entry for /tmp.
=item *
Out of Memory!
Recent perl test suite is quite memory hunrgy. In addition to the comments
above on memory limitations it is also worth checking for _CEE_RUNOPTS
in your environment. Perl now has (in miniperlmain.c) a C #pragma
to set CEE run options, but the environment variable wins.
The C code asks for:
#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
The important parts of that are the second argument (the increment) to HEAP,
and allowing the stack to be "Above the (16M) line". If the heap
increment is too small then when perl (for example loading unicode/Name.pl) tries
to create a "big" (400K+) string it cannot fit in a single segment
and you get "Out of Memory!" - even if there is still plenty of memory
available.
A related issue is use with perl's malloc. Perl's malloc uses C<sbrk()>
to get memory, and C<sbrk()> is limited to the first allocation so in this
case something like:
HEAP(8M,500K,ANYWHERE,KEEP,8K,4K)
is needed to get through the test suite.
=back
=head2 Installation Anomalies with Perl on OS/390
The installman script will try to run on OS/390. There will be fewer errors
if you have a roff utility installed. You can obtain GNU groff from the
Redbook SG24-5944-00 ftp site.
=head2 Usage Hints for Perl on OS/390
When using perl on OS/390 please keep in mind that the EBCDIC and ASCII
character sets are different. See perlebcdic.pod for more on such character
set issues. Perl builtin functions that may behave differently under
EBCDIC are also mentioned in the perlport.pod document.
Open Edition (UNIX System Services) from V2R8 onward does support
#!/path/to/perl script invocation. There is a PTF available from
IBM for V2R7 that will allow shell/kernel support for #!. USS
releases prior to V2R7 did not support the #! means of script invocation.
If you are running V2R6 or earlier then see:
head `whence perldoc`
for an example of how to use the "eval exec" trick to ask the shell to
have Perl run your scripts on those older releases of Unix System Services.
If you are having trouble with square brackets then consider switching your
rlogin or telnet client. Try to avoid older 3270 emulators and ISHELL for
working with Perl on USS.
=head2 Floating Point Anomalies with Perl on OS/390
There appears to be a bug in the floating point implementation on S/390
systems such that calling int() on the product of a number and a small
magnitude number is not the same as calling int() on the quotient of
that number and a large magnitude number. For example, in the following
Perl code:
my $x = 100000.0;
my $y = int($x * 1e-5) * 1e5; # '0'
my $z = int($x / 1e+5) * 1e5; # '100000'
print "\$y is $y and \$z is $z\n"; # $y is 0 and $z is 100000
Although one would expect the quantities $y and $z to be the same and equal
to 100000 they will differ and instead will be 0 and 100000 respectively.
The problem can be further examined in a roughly equivalent C program:
#include <stdio.h>
#include <math.h>
main()
{
double r1,r2;
double x = 100000.0;
double y = 0.0;
double z = 0.0;
x = 100000.0 * 1e-5;
r1 = modf (x,&y);
x = 100000.0 / 1e+5;
r2 = modf (x,&z);
printf("y is %e and z is %e\n",y*1e5,z*1e5);
/* y is 0.000000e+00 and z is 1.000000e+05 (with c89) */
}
=head2 Modules and Extensions for Perl on OS/390
Pure pure (that is non xs) modules may be installed via the usual:
perl Makefile.PL
make
make test
make install
If you built perl with dynamic loading capability then that would also
be the way to build xs based extensions. However, if you built perl with
the default static linking you can still build xs based extensions for OS/390
but you will need to follow the instructions in ExtUtils::MakeMaker for
building statically linked perl binaries. In the simplest configurations
building a static perl + xs extension boils down to:
perl Makefile.PL
make
make perl
make test
make install
make -f Makefile.aperl inst_perl MAP_TARGET=perl
In most cases people have reported better results with GNU make rather
than the system's /bin/make program, whether for plain modules or for
xs based extensions.
If the make process encounters trouble with either compilation or
linking then try setting the _C89_CCMODE to 1. Assuming sh is your
login shell then run:
export _C89_CCMODE=1
If tcsh is your login shell then use the setenv command.
=head1 AUTHORS
David Fiander and Peter Prymmer with thanks to Dennis Longnecker
and William Raffloer for valuable reports, LPAR and PTF feedback.
Thanks to Mike MacIsaac and Egon Terwedow for SG24-5944-00.
Thanks to Ignasi Roca for pointing out the floating point problems.
Thanks to John Goodyear for dynamic loading help.
=head1 SEE ALSO
L<INSTALL>, L<perlport>, L<perlebcdic>, L<ExtUtils::MakeMaker>.
http://www-1.ibm.com/servers/eserver/zseries/zos/unix/bpxa1toy.html
http://www.redbooks.ibm.com/abstracts/sg245944.html
http://www-1.ibm.com/servers/eserver/zseries/zos/unix/bpxa1ty1.html#opensrc
http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/
http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/ceea3030/
http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/CBCUG030/
=head2 Mailing list for Perl on OS/390
If you are interested in the VM/ESA, z/OS (formerly known as OS/390)
and POSIX-BC (BS2000) ports of Perl then see the perl-mvs mailing list.
To subscribe, send an empty message to perl-mvs-subscribe at perl.org.
See also:
http://lists.perl.org/showlist.cgi?name=perl-mvs
There are web archives of the mailing list at:
http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/
http://archive.develooper.com/perl-mvs@perl.org/
=head1 HISTORY
This document was originally written by David Fiander for the 5.005
release of Perl.
This document was podified for the 5.005_03 release of Perl 11 March 1999.
Updated 28 November 2001 for broken URLs.
Updated 12 November 2000 for the 5.7.1 release of Perl.
Updated 15 January 2001 for the 5.7.1 release of Perl.
Updated 24 January 2001 to mention dynamic loading.
Updated 12 March 2001 to mention //'SYS1.TCPPARMS(TCPDATA)'.
=cut
--- NEW FILE: taint.c ---
/* taint.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "...we will have peace, when you and all your works have perished--and
* the works of your dark master to whom you would deliver us. You are a
* liar, Saruman, and a corrupter of men's hearts." --Theoden
*/
/* This file contains a few functions for handling data tainting in Perl
*/
#include "EXTERN.h"
#define PERL_IN_TAINT_C
#include "perl.h"
void
Perl_taint_proper(pTHX_ const char *f, const char *s)
{
#if defined(HAS_SETEUID) && defined(DEBUGGING)
# if Uid_t_size == 1
{
const UV uid = PL_uid;
const UV euid = PL_euid;
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"UVuf" %"UVuf"\n",
s, PL_tainted, uid, euid));
}
# else
{
const IV uid = PL_uid;
const IV euid = PL_euid;
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"IVdf" %"IVdf"\n",
s, PL_tainted, uid, euid));
}
# endif
#endif
if (PL_tainted) {
const char *ug;
if (!f)
f = PL_no_security;
if (PL_euid != PL_uid)
ug = " while running setuid";
else if (PL_egid != PL_gid)
ug = " while running setgid";
else if (PL_taint_warn)
ug = " while running with -t switch";
else
ug = " while running with -T switch";
if (PL_unsafe || PL_taint_warn) {
if(ckWARN(WARN_TAINT))
Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
}
else {
Perl_croak(aTHX_ f, s, ug);
}
}
}
void
Perl_taint_env(pTHX)
{
SV** svp;
MAGIC* mg;
const char* const *e;
static const char* const misc_env[] = {
"IFS", /* most shells' inter-field separators */
"CDPATH", /* ksh dain bramage #1 */
"ENV", /* ksh dain bramage #2 */
"BASH_ENV", /* bash dain bramage -- I guess it's contagious */
NULL
};
/* Don't bother if there's no *ENV glob */
if (!PL_envgv)
return;
/* If there's no %ENV hash of if it's not magical, croak, because
* it probably doesn't reflect the actual environment */
if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
&& mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
const bool was_tainted = PL_tainted;
const char * const name = GvENAME(PL_envgv);
PL_tainted = TRUE;
if (strEQ(name,"ENV"))
/* hash alias */
taint_proper("%%ENV is aliased to %s%s", "another variable");
else
/* glob alias: report it in the error message */
taint_proper("%%ENV is aliased to %%%s%s", name);
/* this statement is reached under -t or -U */
PL_tainted = was_tainted;
}
#ifdef VMS
{
int i = 0;
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
while (1) {
if (i)
(void)sprintf(name,"DCL$PATH;%d", i);
svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
if (!svp || *svp == &PL_sv_undef)
break;
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
}
i++;
}
}
#endif /* VMS */
svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
if (svp && *svp) {
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
}
}
#ifndef VMS
/* tainted $TERM is okay if it contains no metachars */
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
STRLEN len;
const bool was_tainted = PL_tainted;
const char *t = SvPV_const(*svp, len);
const char * const e = t + len;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
t++;
if (t < e) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", "TERM");
}
}
#endif /* !VMS */
for (e = misc_env; *e; e++) {
SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: uconfig.h ---
/*
* This file was produced by running the config_h.SH script, which
* gets its values from uconfig.sh, which is generally produced by
* running Configure.
*
* Feel free to modify any of this as the need arises. Note, however,
* that running config_h.SH again will wipe out any changes you've made.
* For a more permanent change edit uconfig.sh and rerun config_h.SH.
*
* $Id: uconfig.h,v 1.1 2006-12-04 16:58:54 dslinux_cayenne Exp $
*/
/*
* Package name :
* Source directory :
* Configuration time:
* Configured by :
* Target system : unknown
*/
[...4312 lines suppressed...]
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
* is defined.
*/
/*#define HAS_SETSERVENT_R / **/
#define SETSERVENT_R_PROTO 0 /**/
/* HAS_TTYNAME_R:
* This symbol, if defined, indicates that the ttyname_r routine
* is available to ttyname re-entrantly.
*/
/* TTYNAME_R_PROTO:
* This symbol encodes the prototype of ttyname_r.
* It is zero if d_ttyname_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
#endif
--- NEW FILE: config_h.SH ---
case "$CONFIG_SH" in
'') CONFIG_SH=config.sh ;;
esac
case "$CONFIG_H" in
'') CONFIG_H=config.h ;;
esac
case $PERL_CONFIG_SH in
'')
if test -f $CONFIG_SH; then TOP=.;
elif test -f ../$CONFIG_SH; then TOP=..;
elif test -f ../../$CONFIG_SH; then TOP=../..;
elif test -f ../../../$CONFIG_SH; then TOP=../../..;
elif test -f ../../../../$CONFIG_SH; then TOP=../../../..;
else
echo "Can't find $CONFIG_SH."; exit 1
fi
. $TOP/$CONFIG_SH
;;
esac
[...4357 lines suppressed...]
* is defined.
*/
#$d_setservent_r HAS_SETSERVENT_R /**/
#define SETSERVENT_R_PROTO $setservent_r_proto /**/
/* HAS_TTYNAME_R:
* This symbol, if defined, indicates that the ttyname_r routine
* is available to ttyname re-entrantly.
*/
/* TTYNAME_R_PROTO:
* This symbol encodes the prototype of ttyname_r.
* It is zero if d_ttyname_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
* is defined.
*/
#$d_ttyname_r HAS_TTYNAME_R /**/
#define TTYNAME_R_PROTO $ttyname_r_proto /**/
#endif
!GROK!THIS!
--- NEW FILE: scope.c ---
/* scope.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "For the fashion of Minas Tirith was such that it was built on seven
* levels..."
*/
/* This file contains functions to manipulate several of Perl's stacks;
* in particular it contains code to push various types of things onto
* the savestack, then to pop them off and perform the correct restorative
* action for each one. This corresponds to the cleanup Perl does at
[...1154 lines suppressed...]
PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
PTR2UV(cx->sb_m));
PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
PTR2UV(cx->sb_strend));
PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
PTR2UV(cx->sb_rxres));
break;
}
#endif /* DEBUGGING */
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.vmesa ---
This document is written in pod format hence there are punctuation
characters in odd places. Do not worry, you've apparently got
the ASCII->EBCDIC translation worked out correctly. You can read
more about pod in pod/perlpod.pod or the short summary in the
INSTALL file.
=head1 NAME
README.vmesa - building and installing Perl for VM/ESA.
=head1 SYNOPSIS
This document will help you Configure, build, test and install Perl
on VM/ESA.
=head1 DESCRIPTION
This is a fully ported perl for VM/ESA 2.3.0. It may work on
other versions, but that's the one we've tested it on.
If you've downloaded the binary distribution, it needs to be
installed below /usr/local. Source code distributions have an
automated "make install" step that means you do not need to extract
the source code below /usr/local (though that is where it will be
installed by default). You may need to worry about the networking
configuration files discussed in the last bullet below.
=head2 Unpacking Perl Distribution on VM/ESA
To extract an ASCII tar archive on VM/ESA, try this:
pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar
=head2 Setup Perl and utilities on VM/ESA
GNU make for VM/ESA, which may be required for the build of perl,
is available from:
http://vm.marist.edu/~neale/vmoe.html
=head2 Configure Perl on VM/ESA
Once you've unpacked the distribution, run Configure (see INSTALL for
full discussion of the Configure options), and then run make, then
"make test" then "make install" (this last step may require UID=0
privileges).
There is a "hints" file for vmesa that specifies the correct values
for most things. Some things to watch out for are:
=over 4
=item *
this port does support dynamic loading but it's not had much testing
=item *
Don't turn on the compiler optimization flag "-O". There's
a bug in the compiler (APAR PQ18812) that generates some bad code
the optimizer is on.
=item *
As VM/ESA doesn't fully support the fork() API programs relying on
this call will not work. I've replaced fork()/exec() with spawn()
and the standalone exec() with spawn(). This has a side effect when
opening unnamed pipes in a shell script: there is no child process
generated under.
=item *
At the moment the hints file for VM/ESA basically bypasses all of the
automatic configuration process. This is because Configure relies on:
1. The header files living in the Byte File System (you could put the
there if you want); 2. The C preprocessor including the #include
statements in the preprocessor output (.i) file.
=back
=head2 Testing Anomalies of Perl on VM/ESA
The "make test" step runs a Perl Verification Procedure, usually before
installation. As the 5.6.1 kit was being assembled
the following "failures" were known to appear on some machines
during "make test" (mostly due to ASCII vs. EBCDIC conflicts),
your results may differ:
[the list of failures being compiled]
=head2 Usage Hints for Perl on VM/ESA
When using perl on VM/ESA please keep in mind that the EBCDIC and ASCII
character sets are different. Perl builtin functions that may behave
differently under EBCDIC are mentioned in the perlport.pod document.
OpenEdition (UNIX System Services) does not (yet) support the #! means
of script invocation.
See:
head `whence perldoc`
for an example of how to use the "eval exec" trick to ask the shell to
have perl run your scripts for you.
=head1 AUTHORS
Neale Ferguson.
=head1 SEE ALSO
L<INSTALL>, L<perlport>, L<perlebcdic>.
=head2 Mailing list for Perl on VM/ESA
If you are interested in the VM/ESA, z/OS (formerly known as OS/390)
and POSIX-BC (BS2000) ports of Perl then see the perl-mvs mailing list.
To subscribe, send an empty message to perl-mvs-subscribe at perl.org.
See also:
http://lists.perl.org/showlist.cgi?name=perl-mvs
There are web archives of the mailing list at:
http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/
http://archive.develooper.com/perl-mvs@perl.org/
=cut
--- NEW FILE: opcode.pl ---
#!/usr/bin/perl
BEGIN {
# Get function prototypes
require 'regen_lib.pl';
}
$opcode_new = 'opcode.h-new';
$opname_new = 'opnames.h-new';
open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n";
binmode OC;
open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n";
binmode ON;
select OC;
# Read data.
while (<DATA>) {
chop;
next unless $_;
next if /^#/;
($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5);
warn qq[Description "$desc" duplicates $seen{$desc}\n] if $seen{$desc};
die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key};
$seen{$desc} = qq[description of opcode "$key"];
$seen{$key} = qq[opcode "$key"];
push(@ops, $key);
$desc{$key} = $desc;
$check{$key} = $check;
$ckname{$check}++;
$flags{$key} = $flags;
$args{$key} = $args;
}
# Emit defines.
$i = 0;
print <<"END";
/* -*- buffer-read-only: t -*-
*
* opcode.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by opcode.pl from its data. Any changes made here
* will be lost!
*/
#define Perl_pp_i_preinc Perl_pp_preinc
#define Perl_pp_i_predec Perl_pp_predec
#define Perl_pp_i_postinc Perl_pp_postinc
#define Perl_pp_i_postdec Perl_pp_postdec
END
print ON <<"END";
/* -*- buffer-read-only: t -*-
*
* opnames.h
*
* Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by opcode.pl from its data. Any changes made here
* will be lost!
*/
typedef enum opcode {
END
for (@ops) {
print ON "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n";
}
print ON "\t", &tab(3,"OP_max"), "\n";
print ON "} opcode;\n";
print ON "\n#define MAXO ", scalar @ops, "\n";
print ON "#define OP_phoney_INPUT_ONLY -1\n";
print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n";
# Emit op names and descriptions.
print <<END;
START_EXTERN_C
#define OP_NAME(o) ((o)->op_type == OP_CUSTOM ? custom_op_name(o) : \\
PL_op_name[(o)->op_type])
#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \\
PL_op_desc[(o)->op_type])
#ifndef DOINIT
EXT char *PL_op_name[];
#else
EXT char *PL_op_name[] = {
END
for (@ops) {
print qq(\t"$_",\n);
}
print <<END;
};
#endif
END
print <<END;
#ifndef DOINIT
EXT char *PL_op_desc[];
#else
EXT char *PL_op_desc[] = {
END
for (@ops) {
my($safe_desc) = $desc{$_};
# Have to escape double quotes and escape characters.
$safe_desc =~ s/(^|[^\\])([\\"])/$1\\$2/g;
print qq(\t"$safe_desc",\n);
}
print <<END;
};
#endif
END_EXTERN_C
END
# Emit function declarations.
#for (sort keys %ckname) {
# print "OP *\t", &tab(3,$_),"(pTHX_ OP* o);\n";
#}
#
#print "\n";
#
#for (@ops) {
# print "OP *\t", &tab(3, "pp_$_"), "(pTHX);\n";
#}
# Emit ppcode switch array.
print <<END;
START_EXTERN_C
#ifndef DOINIT
EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX);
#else
EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
END
for (@ops) {
print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n" unless $_ eq "custom";
}
print <<END;
};
#endif
END
# Emit check routines.
print <<END;
#ifndef DOINIT
EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op);
#else
EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
END
for (@ops) {
print "\t", &tab(3, "MEMBER_TO_FPTR(Perl_$check{$_}),"), "\t/* $_ */\n";
}
print <<END;
};
#endif
END
# Emit allowed argument types.
print <<END;
#ifndef DOINIT
EXT U32 PL_opargs[];
#else
EXT U32 PL_opargs[] = {
END
%argnum = (
S, 1, # scalar
L, 2, # list
A, 3, # array value
H, 4, # hash value
C, 5, # code value
F, 6, # file value
R, 7, # scalar reference
);
%opclass = (
'0', 0, # baseop
'1', 1, # unop
'2', 2, # binop
'|', 3, # logop
'@', 4, # listop
'/', 5, # pmop
'$', 6, # svop_or_padop
'#', 7, # padop
'"', 8, # pvop_or_svop
'{', 9, # loop
';', 10, # cop
'%', 11, # baseop_or_unop
'-', 12, # filestatop
'}', 13, # loopexop
);
my %OP_IS_SOCKET;
my %OP_IS_FILETEST;
for (@ops) {
$argsum = 0;
$flags = $flags{$_};
$argsum |= 1 if $flags =~ /m/; # needs stack mark
$argsum |= 2 if $flags =~ /f/; # fold constants
$argsum |= 4 if $flags =~ /s/; # always produces scalar
$argsum |= 8 if $flags =~ /t/; # needs target scalar
$argsum |= (8|256) if $flags =~ /T/; # ... which may be lexical
$argsum |= 16 if $flags =~ /i/; # always produces integer
$argsum |= 32 if $flags =~ /I/; # has corresponding int op
$argsum |= 64 if $flags =~ /d/; # danger, unknown side effects
$argsum |= 128 if $flags =~ /u/; # defaults to $_
$flags =~ /([\W\d_])/ or die qq[Opcode "$_" has no class indicator];
$argsum |= $opclass{$1} << 9;
$mul = 0x2000; # 2 ^ OASHIFT
for $arg (split(' ',$args{$_})) {
if ($arg =~ /^F/) {
$OP_IS_SOCKET{$_} = 1 if $arg =~ s/s//;
$OP_IS_FILETEST{$_} = 1 if $arg =~ s/-//;
}
$argnum = ($arg =~ s/\?//) ? 8 : 0;
die "op = $_, arg = $arg\n" unless length($arg) == 1;
$argnum += $argnum{$arg};
warn "# Conflicting bit 32 for '$_'.\n"
if $argnum & 8 and $mul == 0x10000000;
$argsum += $argnum * $mul;
$mul <<= 4;
}
$argsum = sprintf("0x%08x", $argsum);
print "\t", &tab(3, "$argsum,"), "/* $_ */\n";
}
print <<END;
};
#endif
END_EXTERN_C
END
if (keys %OP_IS_SOCKET) {
print ON "\n#define OP_IS_SOCKET(op) \\\n\t(";
print ON join(" || \\\n\t ",
map { "(op) == OP_" . uc() } sort keys %OP_IS_SOCKET);
print ON ")\n\n";
}
if (keys %OP_IS_FILETEST) {
print ON "\n#define OP_IS_FILETEST(op) \\\n\t(";
print ON join(" || \\\n\t ",
map { "(op) == OP_" . uc() } sort keys %OP_IS_FILETEST);
print ON ")\n\n";
}
print OC "/* ex: set ro: */\n";
print ON "/* ex: set ro: */\n";
close OC or die "Error closing opcode.h: $!";
close ON or die "Error closing opnames.h: $!";
foreach ('opcode.h', 'opnames.h') {
safer_rename_silent $_, "$_-old";
}
safer_rename $opcode_new, 'opcode.h';
safer_rename $opname_new, 'opnames.h';
$pp_proto_new = 'pp_proto.h-new';
$pp_sym_new = 'pp.sym-new';
open PP, ">$pp_proto_new" or die "Error creating $pp_proto_new: $!";
binmode PP;
open PPSYM, ">$pp_sym_new" or die "Error creating $pp_sym_new: $!";
binmode PPSYM;
print PP <<"END";
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by opcode.pl from its data. Any changes made here
will be lost!
*/
END
print PPSYM <<"END";
# -*- buffer-read-only: t -*-
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by opcode.pl from its data. Any changes made here
# will be lost!
#
END
for (sort keys %ckname) {
print PP "PERL_CKDEF(Perl_$_)\n";
print PPSYM "Perl_$_\n";
#OP *\t", &tab(3,$_),"(OP* o);\n";
}
print PP "\n\n";
for (@ops) {
next if /^i_(pre|post)(inc|dec)$/;
next if /^custom$/;
print PP "PERL_PPDEF(Perl_pp_$_)\n";
print PPSYM "Perl_pp_$_\n";
}
print PP "\n/* ex: set ro: */\n";
print PPSYM "\n# ex: set ro:\n";
close PP or die "Error closing pp_proto.h: $!";
close PPSYM or die "Error closing pp.sym: $!";
foreach ('pp_proto.h', 'pp.sym') {
safer_rename_silent $_, "$_-old";
}
safer_rename $pp_proto_new, 'pp_proto.h';
safer_rename $pp_sym_new, 'pp.sym';
END {
foreach ('opcode.h', 'opnames.h', 'pp_proto.h', 'pp.sym') {
1 while unlink "$_-old";
}
}
###########################################################################
sub tab {
local($l, $t) = @_;
$t .= "\t" x ($l - (length($t) + 1) / 8);
$t;
}
###########################################################################
# Some comments about 'T' opcode classifier:
# Safe to set if the ppcode uses:
# tryAMAGICbin, tryAMAGICun, SETn, SETi, SETu, PUSHn, PUSHTARG, SETTARG,
# SETs(TARG), XPUSHn, XPUSHu,
# Unsafe to set if the ppcode uses dTARG or [X]RETPUSH[YES|NO|UNDEF]
# lt and friends do SETs (including ncmp, but not scmp)
# Additional mode of failure: the opcode can modify TARG before it "used"
# all the arguments (or may call an external function which does the same).
# If the target coincides with one of the arguments ==> kaboom.
# pp.c pos substr each not OK (RETPUSHUNDEF)
# substr vec also not OK due to LV to target (are they???)
# ref not OK (RETPUSHNO)
# trans not OK (dTARG; TARG = sv_newmortal();)
# ucfirst etc not OK: TMP arg processed inplace
# quotemeta not OK (unsafe when TARG == arg)
# each repeat not OK too due to list context
# pack split - unknown whether they are safe
# sprintf: is calling do_sprintf(TARG,...) which can act on TARG
# before other args are processed.
# Suspicious wrt "additional mode of failure" (and only it):
# schop, chop, postinc/dec, bit_and etc, negate, complement.
# Also suspicious: 4-arg substr, sprintf, uc/lc (POK_only), reverse, pack.
# substr/vec: doing TAINT_off()???
# pp_hot.c
# readline - unknown whether it is safe
# match subst not OK (dTARG)
# grepwhile not OK (not always setting)
# join not OK (unsafe when TARG == arg)
# Suspicious wrt "additional mode of failure": concat (dealt with
# in ck_sassign()), join (same).
# pp_ctl.c
# mapwhile flip caller not OK (not always setting)
# pp_sys.c
# backtick glob warn die not OK (not always setting)
# warn not OK (RETPUSHYES)
# open fileno getc sysread syswrite ioctl accept shutdown
# ftsize(etc) readlink telldir fork alarm getlogin not OK (RETPUSHUNDEF)
# umask select not OK (XPUSHs(&PL_sv_undef);)
# fileno getc sysread syswrite tell not OK (meth("FILENO" "GETC"))
# sselect shm* sem* msg* syscall - unknown whether they are safe
# gmtime not OK (list context)
# Suspicious wrt "additional mode of failure": warn, die, select.
__END__
# New ops always go at the end, just before 'custom'
# A recapitulation of the format of this file:
# The file consists of five columns: the name of the op, an English
# description, the name of the "check" routine used to optimize this
# operation, some flags, and a description of the operands.
# The flags consist of options followed by a mandatory op class signifier
# The classes are:
# baseop - 0 unop - 1 binop - 2
# logop - | listop - @ pmop - /
# padop/svop - $ padop - # (unused) loop - {
# baseop/unop - % loopexop - } filestatop - -
# pvop/svop - " cop - ;
# Other options are:
# needs stack mark - m
# needs constant folding - f
# produces a scalar - s
# produces an integer - i
# needs a target - t
# target can be in a pad - T
# has a corresponding integer version - I
# has side effects - d
# uses $_ if no argument given - u
# Values for the operands are:
# scalar - S list - L array - A
# hash - H sub (CV) - C file - F
# socket - Fs filetest - F- reference - R
# "?" denotes an optional operand.
# Nothing.
null null operation ck_null 0
stub stub ck_null 0
scalar scalar ck_fun s% S
# Pushy stuff.
pushmark pushmark ck_null s0
wantarray wantarray ck_null is0
const constant item ck_svconst s$
gvsv scalar variable ck_null ds$
gv glob value ck_null ds$
gelem glob elem ck_null d2 S S
padsv private variable ck_null ds0
padav private array ck_null d0
padhv private hash ck_null d0
padany private value ck_null d0
pushre push regexp ck_null d/
# References and stuff.
rv2gv ref-to-glob cast ck_rvconst ds1
rv2sv scalar dereference ck_rvconst ds1
av2arylen array length ck_null is1
rv2cv subroutine dereference ck_rvconst d1
anoncode anonymous subroutine ck_anoncode $
prototype subroutine prototype ck_null s% S
refgen reference constructor ck_spair m1 L
srefgen single ref constructor ck_null fs1 S
ref reference-type operator ck_fun stu% S?
bless bless ck_fun s@ S S?
# Pushy I/O.
backtick quoted execution (``, qx) ck_open t%
# glob defaults its first arg to $_
glob glob ck_glob t@ S?
readline <HANDLE> ck_null t% F?
rcatline append I/O operator ck_null t$
# Bindable operators.
regcmaybe regexp internal guard ck_fun s1 S
regcreset regexp internal reset ck_fun s1 S
regcomp regexp compilation ck_null s| S
match pattern match (m//) ck_match d/
qr pattern quote (qr//) ck_match s/
subst substitution (s///) ck_null dis/ S
substcont substitution iterator ck_null dis|
trans transliteration (tr///) ck_null is" S
# Lvalue operators.
# sassign is special-cased for op class
sassign scalar assignment ck_sassign s0
aassign list assignment ck_null t2 L L
chop chop ck_spair mts% L
schop scalar chop ck_null stu% S?
chomp chomp ck_spair mTs% L
schomp scalar chomp ck_null sTu% S?
defined defined operator ck_defined isu% S?
undef undef operator ck_lfun s% S?
study study ck_fun su% S?
pos match position ck_lfun stu% S?
preinc preincrement (++) ck_lfun dIs1 S
i_preinc integer preincrement (++) ck_lfun dis1 S
predec predecrement (--) ck_lfun dIs1 S
i_predec integer predecrement (--) ck_lfun dis1 S
postinc postincrement (++) ck_lfun dIst1 S
i_postinc integer postincrement (++) ck_lfun disT1 S
postdec postdecrement (--) ck_lfun dIst1 S
i_postdec integer postdecrement (--) ck_lfun disT1 S
# Ordinary operators.
pow exponentiation (**) ck_null fsT2 S S
multiply multiplication (*) ck_null IfsT2 S S
i_multiply integer multiplication (*) ck_null ifsT2 S S
divide division (/) ck_null IfsT2 S S
i_divide integer division (/) ck_null ifsT2 S S
modulo modulus (%) ck_null IifsT2 S S
i_modulo integer modulus (%) ck_null ifsT2 S S
repeat repeat (x) ck_repeat mt2 L S
add addition (+) ck_null IfsT2 S S
i_add integer addition (+) ck_null ifsT2 S S
subtract subtraction (-) ck_null IfsT2 S S
i_subtract integer subtraction (-) ck_null ifsT2 S S
concat concatenation (.) or string ck_concat fsT2 S S
stringify string ck_fun fsT@ S
left_shift left bitshift (<<) ck_bitop fsT2 S S
right_shift right bitshift (>>) ck_bitop fsT2 S S
lt numeric lt (<) ck_null Iifs2 S S
i_lt integer lt (<) ck_null ifs2 S S
gt numeric gt (>) ck_null Iifs2 S S
i_gt integer gt (>) ck_null ifs2 S S
le numeric le (<=) ck_null Iifs2 S S
i_le integer le (<=) ck_null ifs2 S S
ge numeric ge (>=) ck_null Iifs2 S S
i_ge integer ge (>=) ck_null ifs2 S S
eq numeric eq (==) ck_null Iifs2 S S
i_eq integer eq (==) ck_null ifs2 S S
ne numeric ne (!=) ck_null Iifs2 S S
i_ne integer ne (!=) ck_null ifs2 S S
ncmp numeric comparison (<=>) ck_null Iifst2 S S
i_ncmp integer comparison (<=>) ck_null ifst2 S S
slt string lt ck_null ifs2 S S
sgt string gt ck_null ifs2 S S
sle string le ck_null ifs2 S S
sge string ge ck_null ifs2 S S
seq string eq ck_null ifs2 S S
sne string ne ck_null ifs2 S S
scmp string comparison (cmp) ck_null ifst2 S S
bit_and bitwise and (&) ck_bitop fst2 S S
bit_xor bitwise xor (^) ck_bitop fst2 S S
bit_or bitwise or (|) ck_bitop fst2 S S
negate negation (-) ck_null Ifst1 S
i_negate integer negation (-) ck_null ifsT1 S
not not ck_null ifs1 S
complement 1's complement (~) ck_bitop fst1 S
# High falutin' math.
atan2 atan2 ck_fun fsT@ S S
sin sin ck_fun fsTu% S?
cos cos ck_fun fsTu% S?
rand rand ck_fun sT% S?
srand srand ck_fun s% S?
exp exp ck_fun fsTu% S?
log log ck_fun fsTu% S?
sqrt sqrt ck_fun fsTu% S?
# Lowbrow math.
int int ck_fun fsTu% S?
hex hex ck_fun fsTu% S?
oct oct ck_fun fsTu% S?
abs abs ck_fun fsTu% S?
# String stuff.
length length ck_lengthconst isTu% S?
substr substr ck_substr st@ S S S? S?
vec vec ck_fun ist@ S S S
index index ck_index isT@ S S S?
rindex rindex ck_index isT@ S S S?
sprintf sprintf ck_fun mst@ S L
formline formline ck_fun ms@ S L
ord ord ck_fun ifsTu% S?
chr chr ck_fun fsTu% S?
crypt crypt ck_fun fsT@ S S
ucfirst ucfirst ck_fun fstu% S?
lcfirst lcfirst ck_fun fstu% S?
uc uc ck_fun fstu% S?
lc lc ck_fun fstu% S?
quotemeta quotemeta ck_fun fstu% S?
# Arrays.
rv2av array dereference ck_rvconst dt1
aelemfast constant array element ck_null s$ A S
aelem array element ck_null s2 A S
aslice array slice ck_null m@ A L
# Hashes.
each each ck_fun % H
values values ck_fun t% H
keys keys ck_fun t% H
delete delete ck_delete % S
exists exists ck_exists is% S
rv2hv hash dereference ck_rvconst dt1
helem hash element ck_null s2@ H S
hslice hash slice ck_null m@ H L
# Explosives and implosives.
unpack unpack ck_fun @ S S
pack pack ck_fun mst@ S L
split split ck_split t@ S S S
join join or string ck_join mst@ S L
# List operators.
list list ck_null m@ L
lslice list slice ck_null 2 H L L
anonlist anonymous list ([]) ck_fun ms@ L
anonhash anonymous hash ({}) ck_fun ms@ L
splice splice ck_fun m@ A S? S? L
push push ck_fun imsT@ A L
pop pop ck_shift s% A?
shift shift ck_shift s% A?
unshift unshift ck_fun imsT@ A L
sort sort ck_sort m@ C? L
reverse reverse ck_fun mt@ L
grepstart grep ck_grep dm@ C L
grepwhile grep iterator ck_null dt|
mapstart map ck_grep dm@ C L
mapwhile map iterator ck_null dt|
# Range stuff.
range flipflop ck_null | S S
flip range (or flip) ck_null 1 S S
flop range (or flop) ck_null 1
# Control.
and logical and (&&) ck_null |
or logical or (||) ck_null |
xor logical xor ck_null fs2 S S
cond_expr conditional expression ck_null d|
andassign logical and assignment (&&=) ck_null s|
orassign logical or assignment (||=) ck_null s|
method method lookup ck_method d1
entersub subroutine entry ck_subr dmt1 L
leavesub subroutine exit ck_null 1
leavesublv lvalue subroutine return ck_null 1
caller caller ck_fun t% S?
warn warn ck_fun imst@ L
die die ck_die dimst@ L
reset symbol reset ck_fun is% S?
lineseq line sequence ck_null @
nextstate next statement ck_null s;
dbstate debug next statement ck_null s;
unstack iteration finalizer ck_null s0
enter block entry ck_null 0
leave block exit ck_null @
scope block ck_null @
enteriter foreach loop entry ck_null d{
iter foreach loop iterator ck_null 0
enterloop loop entry ck_null d{
leaveloop loop exit ck_null 2
return return ck_return dm@ L
last last ck_null ds}
next next ck_null ds}
redo redo ck_null ds}
dump dump ck_null ds}
goto goto ck_null ds}
exit exit ck_exit ds% S?
# continued below
#nswitch numeric switch ck_null d
#cswitch character switch ck_null d
# I/O.
open open ck_open ismt@ F S? L
close close ck_fun is% F?
pipe_op pipe ck_fun is@ F F
fileno fileno ck_fun ist% F
umask umask ck_fun ist% S?
binmode binmode ck_fun s@ F S?
tie tie ck_fun idms@ R S L
untie untie ck_fun is% R
tied tied ck_fun s% R
dbmopen dbmopen ck_fun is@ H S S
dbmclose dbmclose ck_fun is% H
sselect select system call ck_select t@ S S S S
select select ck_select st@ F?
getc getc ck_eof st% F?
read read ck_fun imst@ F R S S?
enterwrite write ck_fun dis% F?
leavewrite write exit ck_null 1
prtf printf ck_listiob ims@ F? L
print print ck_listiob ims@ F? L
sysopen sysopen ck_fun s@ F S S S?
sysseek sysseek ck_fun s@ F S S
sysread sysread ck_fun imst@ F R S S?
syswrite syswrite ck_fun imst@ F S S? S?
send send ck_fun imst@ Fs S S S?
recv recv ck_fun imst@ Fs R S S
eof eof ck_eof is% F?
tell tell ck_fun st% F?
seek seek ck_fun s@ F S S
# truncate really behaves as if it had both "S S" and "F S"
truncate truncate ck_trunc is@ S S
fcntl fcntl ck_fun st@ F S S
ioctl ioctl ck_fun st@ F S S
flock flock ck_fun isT@ F S
# Sockets.
socket socket ck_fun is@ Fs S S S
sockpair socketpair ck_fun is@ Fs Fs S S S
bind bind ck_fun is@ Fs S
connect connect ck_fun is@ Fs S
listen listen ck_fun is@ Fs S
accept accept ck_fun ist@ Fs Fs
shutdown shutdown ck_fun ist@ Fs S
gsockopt getsockopt ck_fun is@ Fs S S
ssockopt setsockopt ck_fun is@ Fs S S S
getsockname getsockname ck_fun is% Fs
getpeername getpeername ck_fun is% Fs
# Stat calls.
lstat lstat ck_ftst u- F
stat stat ck_ftst u- F
ftrread -R ck_ftst isu- F-
ftrwrite -W ck_ftst isu- F-
ftrexec -X ck_ftst isu- F-
fteread -r ck_ftst isu- F-
ftewrite -w ck_ftst isu- F-
fteexec -x ck_ftst isu- F-
ftis -e ck_ftst isu- F-
fteowned -o ck_ftst isu- F-
ftrowned -O ck_ftst isu- F-
ftzero -z ck_ftst isu- F-
ftsize -s ck_ftst istu- F-
ftmtime -M ck_ftst stu- F-
ftatime -A ck_ftst stu- F-
ftctime -C ck_ftst stu- F-
ftsock -S ck_ftst isu- F-
ftchr -c ck_ftst isu- F-
ftblk -b ck_ftst isu- F-
ftfile -f ck_ftst isu- F-
ftdir -d ck_ftst isu- F-
ftpipe -p ck_ftst isu- F-
ftlink -l ck_ftst isu- F-
ftsuid -u ck_ftst isu- F-
ftsgid -g ck_ftst isu- F-
ftsvtx -k ck_ftst isu- F-
fttty -t ck_ftst is- F-
fttext -T ck_ftst isu- F-
ftbinary -B ck_ftst isu- F-
# File calls.
chdir chdir ck_fun isT% S?
chown chown ck_fun imsT@ L
chroot chroot ck_fun isTu% S?
unlink unlink ck_fun imsTu@ L
chmod chmod ck_fun imsT@ L
utime utime ck_fun imsT@ L
rename rename ck_fun isT@ S S
link link ck_fun isT@ S S
symlink symlink ck_fun isT@ S S
readlink readlink ck_fun stu% S?
mkdir mkdir ck_fun isT@ S S?
rmdir rmdir ck_fun isTu% S?
# Directory calls.
open_dir opendir ck_fun is@ F S
readdir readdir ck_fun % F
telldir telldir ck_fun st% F
seekdir seekdir ck_fun s@ F S
rewinddir rewinddir ck_fun s% F
closedir closedir ck_fun is% F
# Process control.
fork fork ck_null ist0
wait wait ck_null isT0
waitpid waitpid ck_fun isT@ S S
system system ck_exec imsT@ S? L
exec exec ck_exec dimsT@ S? L
kill kill ck_fun dimsT@ L
getppid getppid ck_null isT0
getpgrp getpgrp ck_fun isT% S?
setpgrp setpgrp ck_fun isT@ S? S?
getpriority getpriority ck_fun isT@ S S
setpriority setpriority ck_fun isT@ S S S
# Time calls.
# NOTE: MacOS patches the 'i' of time() away later when the interpreter
# is created because in MacOS time() is already returning times > 2**31-1,
# that is, non-integers.
time time ck_null isT0
tms times ck_null 0
localtime localtime ck_fun t% S?
gmtime gmtime ck_fun t% S?
alarm alarm ck_fun istu% S?
sleep sleep ck_fun isT% S?
# Shared memory.
shmget shmget ck_fun imst@ S S S
shmctl shmctl ck_fun imst@ S S S
shmread shmread ck_fun imst@ S S S S
shmwrite shmwrite ck_fun imst@ S S S S
# Message passing.
msgget msgget ck_fun imst@ S S
msgctl msgctl ck_fun imst@ S S S
msgsnd msgsnd ck_fun imst@ S S S
msgrcv msgrcv ck_fun imst@ S S S S S
# Semaphores.
semget semget ck_fun imst@ S S S
semctl semctl ck_fun imst@ S S S S
semop semop ck_fun imst@ S S
# Eval.
require require ck_require du% S?
dofile do "file" ck_fun d1 S
entereval eval "string" ck_eval d% S
leaveeval eval "string" exit ck_null 1 S
#evalonce eval constant string ck_null d1 S
entertry eval {block} ck_null |
leavetry eval {block} exit ck_null @
# Get system info.
ghbyname gethostbyname ck_fun % S
ghbyaddr gethostbyaddr ck_fun @ S S
ghostent gethostent ck_null 0
gnbyname getnetbyname ck_fun % S
gnbyaddr getnetbyaddr ck_fun @ S S
gnetent getnetent ck_null 0
gpbyname getprotobyname ck_fun % S
gpbynumber getprotobynumber ck_fun @ S
gprotoent getprotoent ck_null 0
gsbyname getservbyname ck_fun @ S S
gsbyport getservbyport ck_fun @ S S
gservent getservent ck_null 0
shostent sethostent ck_fun is% S
snetent setnetent ck_fun is% S
sprotoent setprotoent ck_fun is% S
sservent setservent ck_fun is% S
ehostent endhostent ck_null is0
enetent endnetent ck_null is0
eprotoent endprotoent ck_null is0
eservent endservent ck_null is0
gpwnam getpwnam ck_fun % S
gpwuid getpwuid ck_fun % S
gpwent getpwent ck_null 0
spwent setpwent ck_null is0
epwent endpwent ck_null is0
ggrnam getgrnam ck_fun % S
ggrgid getgrgid ck_fun % S
ggrent getgrent ck_null 0
sgrent setgrent ck_null is0
egrent endgrent ck_null is0
getlogin getlogin ck_null st0
# Miscellaneous.
syscall syscall ck_fun imst@ S L
# For multi-threading
lock lock ck_rfun s% R
threadsv per-thread value ck_null ds0
# Control (contd.)
setstate set statement info ck_null s;
method_named method with known name ck_null d$
# Add new ops before this, the custom operator.
custom unknown custom operator ck_null 0
--- NEW FILE: makedir.SH ---
case $PERL_CONFIG_SH in
'')
if test ! -f config.sh; then
ln ../config.sh . || \
ln ../../config.sh . || \
ln ../../../config.sh . || \
(echo "Can't find config.sh."; exit 1)
fi 2>/dev/null
. ./config.sh
;;
esac
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting makedir (with variable substitutions)"
rm -f makedir
$spitshell >makedir <<!GROK!THIS!
$startsh
# makedir.SH
#
export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
case \$# in
0)
$echo "makedir pathname filenameflag"
exit 1
;;
esac
: guarantee one slash before 1st component
case \$1 in
/*) ;;
*) set ./\$1 \$2 ;;
esac
: strip last component if it is to be a filename
case X\$2 in
X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
*) set \$1 ;;
esac
: return reasonable status if nothing to be created
if $test -d "\$1" ; then
exit 0
fi
list=''
while true ; do
case \$1 in
*/*)
list="\$1 \$list"
set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
;;
*)
break
;;
esac
done
set \$list
for dir do
$mkdir \$dir >/dev/null 2>&1
done
!GROK!THIS!
$eunicefix makedir
chmod +x makedir
--- NEW FILE: README.mpeix ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
README.mpeix - Perl/iX for HP e3000 MPE
=head1 SYNOPSIS
http://www.bixby.org/mark/perlix.html
http://jazz.external.hp.com/src/hp_freeware/perl/
Perl language for MPE
Last updated January 12, 2006 @ 2100 UTC
=head1 NOTE
This is a podified version of the above-mentioned web page,
podified by Jarkko Hietaniemi 2001-Jan-01.
=head1 Binary distribution from HP
The simplest way to obtain Perl for the MPE/iX is to go either of
these URLs and follow the instructions within.
http://jazz.external.hp.com/src/hp_freeware/perl/
http://www.bixby.org/mark/perlix.html
Use which ever one is more recent.
=head1 What's New in Perl for MPE/iX
January 12, 2006
=over 4
=item *
Updated for perl-5.8.8 and perl-5.9.3 by Ken Hirsch.
Simplified the build process by using the MPEAUTOCONF
functionality in Mark Klein's ld.
If you build this from scratch, make sure you have a version
of ld which supports it. In the shell, type
ld --help
and look for AUTOCONF or MPEAUTOCONF near the bottom
or do this:
ld --help 2>&1 | grep AUTOCONF
If you see don't see AUTOCONF or MPEAUTOCONF, make sure you get a new
version.
You also do not have to use mpeix/relink after building, so the
recommend sequence is:
./Configure -de
# or ./Configure -de -Dusedevel
# if you're building a development version
make
make test
# if you run this in a job, do "make test_notty"
make install
Be prepared for a wait. These take much longer on MPE/iX than on a Unix
system, because of a slow forking, mostly. On a lightly-loaded HP3000
Series 979 running MPE/iX 7.5:
Configure: 1 hour
make: 1 hour 15 minutes
make test 1 hour 45 minutes
Various socket problems were fixed in mpeix.c.
Mark Klein provided a fixed sigsetjmp (that works with dynamic
libraries) in mpeix_setjmp.c
=item *
June 1, 2000
=over 4
=item *
Rebuilt to be compatible with mod_perl. If you plan on using
mod_perl, you MUST download and install this version of Perl/iX!
=item *
uselargefiles="undef": not available in MPE for POSIX files yet.
=item *
Now bundled with various add-on packages:
=over 8
=item *
libnet (as seen on CPAN)
=item *
libwww-perl (LWP) which lets Perl programs behave like web browsers:
1. #!/PERL/PUB/perl
2. use LWP::Simple;
3. $doc = get('http://www.bixby.org/mark/perlix.html'); # reads the
web page into variable $doc
(http://www.bixby.org/mark/perlix.html)
=item *
mod_perl (just the perl portion; the actual DSO will be released
soon with Apache/iX 1.3.12 from bixby.org). This module allows you to
write high performance persistent Perl CGI scripts and all sorts of
cool things. (http://perl.apache.org/)
and much much more hiding under /PERL/PUB/.cpan/
=item *
The CPAN module now works for automatic downloading and
installing of add-on packages:
1. export FTP_PASSIVE=1
2. perl -MCPAN -e shell
3. Ignore any terminal I/O related complaints!
(http://theoryx5.uwinnipeg.ca/CPAN/data/perl/CPAN.html)
=back
=back
May 20, 2000
=over 4
=item *
Updated to version 5.6.0. Builds straight out of the box on MPE/iX.
=item *
Perl's getpwnam() function which had regressed to being
unimplemented on MPE is now implemented once again.
=back
September 17, 1999
=over 4
=item *
Migrated from cccd.edu to bixby.org.
=back
=head1 Welcome to Perl/iX
This is the official home page for the HP e3000 MPE/iX
( http://www.hp.com/go/e3000 ) port of the Perl scripting
language ( http://www.perl.com/ ) which gives you all of the power of C,
awk, sed, and sh in a single language. Check here for the latest news,
implemented functionality, known bugs, to-do list, etc. Status reports
about major milestones will also be posted to the HP3000-L mailing list
( http://www.lsoft.com/scripts/wl.exe?SL1=HP3000-L&H=RAVEN.UTC.EDU ) and
its associated gatewayed newsgroup comp.sys.hp.mpe.
I'm doing this port because I can't live without Perl on the Unix
machines that I administer, and I want to have the same power
available to me on MPE.
Please send your comments, questions, and bug reports directly to me,
Mark Bixby ( http://www.bixby.org/mark/ ). Or just post them to HP3000-L.
The platform I'm using to do this port is an HP 3000 957RX running
MPE/iX 6.0 and using the GNU gcc C compiler
( http://jazz.external.hp.com/src/gnu/gnuframe.html ).
The combined porting wisdom from all of my ports can be found in my
MPE/iX Porting Guide (http://www.bixby.org/mark/porting.html).
IMPORTANT NOTICE: Yes, I do work for the HP CSY R&D lab, but ALL of
the software you download from bixby.org is my personal freeware that
is NOT supported by HP.
=head1 System Requirements for Perl/iX
=over 4
=item *
MPE/iX 5.5 or later. This version of Perl/iX does NOT run on
MPE/iX 5.0 or earlier, nor does it run on "classic" MPE/V machines.
=item *
If you wish to recompile Perl, you must install both GNUCORE and
GNUGCC from jazz (http://jazz.external.hp.com/src/gnu/gnuframe.html).
=item *
Perl/iX will be happier on MPE/iX 5.5 if you install the MPEKX40B
extended POSIX filename characters patch, but this is optional.
=item *
Patch LBCJXT6A is required on MPE/iX 5.5 machines in order to
prevent Perl/iX from dying with an unresolved external reference
to _getenv_libc.
=item *
If you will be compiling Perl/iX yourself, you will also need
Syslog/iX ( http://www.bixby.org/mark/syslogix.html ) and the
/BIND/PUB/include and /BIND/PUB/lib portions of BIND/iX
( http://www.bixby.org/mark/bindix.html ).
=back
=head1 How to Obtain Perl/iX
=over 4
=item 1.
Download Perl using either FTP.ARPA.SYS or some other client
=item 2.
Extract the installation script
=item 3.
Edit the installation script
=item 4.
Run the installation script
=item 5.
Convert your *.a system archive libraries to *.sl shared libraries
=back
Download Perl using FTP.ARPA.SYS from your HP 3000 (the preferred
method).....
:HELLO MANAGER.SYS
:XEQ FTP.ARPA.SYS
open ftp.bixby.org
anonymous
your at email.address
bytestream
cd /pub/mpe
get perl-5.6.0-mpe.tar.Z /tmp/perl.tar.Z;disc=2147483647
exit
.....Or download using some other generic web or ftp client (the alternate
method)
Download the following files (make sure that you use "binary mode" or
whatever client feature that is 8-bit clean):
=over 4
=item *
Perl from
http://www.bixby.org/ftp/pub/mpe/perl-5.6.0-mpe.tar.Z
or
ftp://ftp.bixby.org/pub/mpe/perl-5.6.0-mpe.tar.Z
=item *
Upload those files to your HP 3000 in an 8-bit clean bytestream manner to:
/tmp/perl.tar.Z
=item *
Then extract the installation script (after both download methods)
:CHDIR /tmp
:XEQ TAR.HPBIN.SYS 'xvfopz /tmp/perl.tar.Z INSTALL'
=item *
Edit the installation script
Examine the accounting structure creation commands and modify if
necessary (adding additional capabilities, choosing a non-system
volume set, etc).
:XEQ VI.HPBIN.SYS /tmp/INSTALL
=item *
Run the installation script.
The accounting structure will be created and then all files will be
extracted from the archive.
:XEQ SH.HPBIN.SYS /tmp/INSTALL
=item *
Convert your *.a system archive libraries to *.sl shared libraries
You only have to do this ONCE on your MPE/iX 5.5 machine in order to
convert /lib/lib*.a and /usr/lib/lib*.a libraries to their *.sl
equivalents. This step should not be necessary on MPE/iX 6.0 or later
machines because the 6.0 or later update process does it for you.
:XEQ SH.HPBIN.SYS /PERL/PUB/LIBSHP3K
=back
=head1 Perl/iX Distribution Contents Highlights
=over 4
=item README
The file you're reading now.
=item INSTALL
Perl/iX Installation script.
=item LIBSHP3K
Script to convert *.a system archive libraries to *.sl shared libraries.
=item PERL
Perl NMPRG executable. A version-numbered backup copy also
exists. You might wish to "ln -s /PERL/PUB/PERL /usr/local/bin/perl".
=item .cpan/
Much add-on source code downloaded with the CPAN module.
=item lib/
Perl libraries, both core and add-on.
=item man/
Perl man page documentation.
=item public_html/feedback.cgi
Sample feedback CGI form written in Perl.
=item src/perl-5.6.0-mpe
Source code.
=back
=head1 How to Compile Perl/iX
=over 4
=item 1.
cd src/perl-5.6.0-mpe
=item 2.
Read the INSTALL file for the official instructions
=item 3.
./Configure -d
=item 4.
make
=item 5.
./mpeix/relink
=item 6.
make test (expect approximately 15 out of 11306 subtests to fail,
mostly due to MPE not supporting hard links, UDP socket problems,
and handling exit() return codes improperly)
=item 7.
make install
=item 8.
Optionally create symbolic links that point to the Perl
executable, i.e. ln -s /PERL/PUB/PERL /usr/local/bin/perl
=back
The summary test results from "cd t; ./perl -I../lib harness":
Failed Test Status Wstat Total Fail Failed List of failed
---------------------------------------------------------------------------
io/fs.t 29 8 27.59% 2-5, 7-9, 11
io/openpid.t 10 1 10.00% 7
lib/io_sock.t 14 1 7.14% 13
lib/io_udp.t 7 2 28.57% 3, 5
lib/posix.t 27 1 3.70% 12
op/lex_assign.t 187 1 0.53% 13
op/stat.t 58 1 1.72% 3
15 tests and 94 subtests skipped.
Failed 7/236 test scripts, 97.03% okay. 15/11306 subtests failed, 99.87% okay.
=head1 Getting Started with Perl/iX
Create your Perl script files with "#!/PERL/PUB/perl" (or an
equivalent symbolic link) as the first line. Use the chmod command to
make sure that your script has execute permission. Run your script!
Be sure to take a look at the CPAN module list
( http://www.cpan.org/CPAN.html ). A wide variety of free Perl software
is available. You can automatically download these packages by using
the CPAN module ( http://theoryx5.uwinnipeg.ca/CPAN/data/perl/CPAN.html ).
=head1 MPE/iX Implementation Considerations
There some minor functionality issues to be aware of when comparing
Perl for Unix (Perl/UX) to Perl/iX:
=over 4
=item *
MPE gcc/ld doesn't properly support linking NMPRG executables against
NMXL dynamic libraries, so you must manually run mpeix/relink after
each re-build of Perl.
=item *
Perl/iX File::Copy will use MPE's /bin/cp command to copy files by
name in order to preserve file attributes like file code.
=item *
MPE (and thus Perl/iX) lacks support for setgrent(), endgrent(),
setpwent(), endpwent().
=item *
MPE (and thus Perl/iX) lacks support for hard links.
=item *
MPE requires GETPRIVMODE() in order to bind() to ports less than 1024.
Perl/iX will call GETPRIVMODE() automatically on your behalf if you
attempt to bind() to these low-numbered ports. Note that the Perl/iX
executable and the PERL account do not normally have CAP=PM, so if you
will be bind()-ing to these privileged ports, you will manually need
to add PM capability as appropriate.
=item *
MPE requires that you bind() to an IP address of zero. Perl/iX
automatically replaces the IP address that you pass to bind() with
a zero.
=item *
MPE requires GETPRIVMODE() in order to setuid(). There are too many
calls to setuid() within Perl/iX, so I have not attempted an automatic
GETPRIVMODE() solution similar to bind().
=back
=head1 Known Perl/iX Bugs Under Investigation
None.
=head1 Perl/iX To-Do List
=over 4
=item *
Make setuid()/setgid() support work.
=item *
Make sure that fcntl() against a socket descriptor is redirected to sfcntl().
=item *
Add support for Berkeley DB once I've finished porting Berkeley DB.
=item *
Write an MPE XS extension library containing miscellaneous important
MPE functions like GETPRIVMODE(), GETUSERMODE(), and sfcntl().
=back
=head1 Perl/iX Change History
May 6, 1999
=over 4
=item *
Patch LBCJXT6A is required on MPE/iX 5.5 machines in order to prevent
Perl/iX from dying with an unresolved external reference to _getenv_libc.
=back
April 7, 1999
=over 4
=item *
Updated to version 5.005_03.
=item *
The official source distribution once again compiles "straight out
of the box" for MPE.
=item *
The current incarnation of the 5.5 POSIX filename extended
characters patch is now MPEKX40B.
=item *
The LIBSHP3K *.a -> *.sl library conversion script is now included
as /PERL/PUB/LIBSHP3K.
=back
November 20, 1998
=over 4
=item *
Updated to version 5.005_02.
=item *
Fixed a DynaLoader bug that was unable to load symbols from relative
path name libraries.
=item *
Fixed a .xs compilation bug where the mpeixish.sh include file wasn't
being installed into the proper directory.
=item *
All bugfixes will be submitted back to the official Perl developers.
=item *
The current incarnation of the POSIX filename extended characters
patch is now MPEKXJ3A.
=back
August 14, 1998
=over 4
=item *
The previous POSIX filename extended characters patch MPEKX44C has
been superseded by MPEKXB5A.
=back
August 7, 1998
=over 4
=item *
The previous POSIX filename extended characters patch MPEKX76A has
been superseded by MPEKX44C.
=back
July 28, 1998
=over 4
=item *
Updated to version 5.005_01.
=back
July 23, 1998
=over 4
=item *
Updated to version 5.005 (production release). The public
freeware sources are now 100% MPE-ready "straight out of the box".
=back
July 17, 1998
=over 4
=item *
Updated to version 5.005b1 (public beta release). The public
freeware sources are now 99.9% MPE-ready. By installing and
testing this beta on your own HP3000, you will be helping to
insure that the final release of 5.005 will be 100% MPE-ready and
100% bug free.
=item *
My MPE binary release is now extracted using my standard INSTALL script.
=back
July 15, 1998
=over 4
=item *
Changed startperl to #!/PERL/PUB/perl so that Perl will recognize
scripts more easily and efficiently.
=back
July 8, 1998
=over 4
=item *
Updated to version 5.004_70 (internal developer release) which is now
MPE-ready. The next public freeware release of Perl should compile
"straight out of the box" on MPE. Note that this version of Perl/iX
was strictly internal to me and never publicly released. Note that
[21]BIND/iX is now required (well, the include files and libbind.a) if
you wish to compile Perl/iX.
=back
November 6, 1997
=over 4
=item *
Updated to version 5.004_04. No changes in MPE-specific functionality.
=back
October 16, 1997
=over 4
=item *
Added Demos section to the Perl/iX home page so you can see some
sample Perl applications running on my 3000.
=back
October 3, 1997
=over 4
=item *
Added System Requirements section to the Perl/iX home page just so the
prerequisites stand out more. Various other home page tweaks.
=back
October 2, 1997
=over 4
=item *
Initial public release.
=back
September 1997
=over 4
=item *
Porting begins.
=back
=head1 AUTHOR
Mark Bixby, http://www.bixby.org/mark/
--- NEW FILE: cv.h ---
/* cv.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
* 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* This structure must match XPVCV in B/C.pm and the beginning of XPVFM
* in sv.h */
struct xpvcv {
char * xpv_pv; /* pointer to malloced string (for prototype) */
STRLEN xpv_cur; /* length of xp_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xof_off; /* integer value */
NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
HV * xcv_stash;
OP * xcv_start;
OP * xcv_root;
void (*xcv_xsub) (pTHX_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
char * xcv_file;
long xcv_depth; /* >= 2 indicates recursive call */
PADLIST * xcv_padlist;
CV * xcv_outside;
#ifdef USE_5005THREADS
perl_mutex *xcv_mutexp;
struct perl_thread *xcv_owner; /* current owner thread */
#endif /* USE_5005THREADS */
cv_flags_t xcv_flags;
U32 xcv_outside_seq; /* the COP sequence (at the point of our
* compilation) in the lexically enclosing
* sub */
};
/*
=head1 Handy Values
=for apidoc AmU||Nullcv
Null CV pointer.
=head1 CV Manipulation Functions
=for apidoc Am|HV*|CvSTASH|CV* cv
Returns the stash of the CV.
=cut
*/
#define Nullcv Null(CV*)
#define CvSTASH(sv) ((XPVCV*)SvANY(sv))->xcv_stash
#define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start
#define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root
#define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub
#define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_xsubany
#define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv
#define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file
#ifdef USE_ITHREADS
# define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = savepv(CopFILE(cop)))
#else
# define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = CopFILE(cop))
#endif
#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv)))
#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
#ifdef USE_5005THREADS
#define CvMUTEXP(sv) ((XPVCV*)SvANY(sv))->xcv_mutexp
#define CvOWNER(sv) ((XPVCV*)SvANY(sv))->xcv_owner
#endif /* USE_5005THREADS */
#define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags
#define CvOUTSIDE_SEQ(sv) ((XPVCV*)SvANY(sv))->xcv_outside_seq
#define CVf_CLONE 0x0001 /* anon CV uses external lexicals */
#define CVf_CLONED 0x0002 /* a clone of one of those */
#define CVf_ANON 0x0004 /* CvGV() can't be trusted */
#define CVf_OLDSTYLE 0x0008
#define CVf_UNIQUE 0x0010 /* sub is only called once (eg PL_main_cv,
* require, eval). Not to be confused
* with the GVf_UNIQUE flag associated
* with the :unique attribute */
#define CVf_NODEBUG 0x0020 /* no DB::sub indirection for this CV
(esp. useful for special XSUBs) */
#define CVf_METHOD 0x0040 /* CV is explicitly marked as a method */
#define CVf_LOCKED 0x0080 /* CV locks itself or first arg on entry */
#define CVf_LVALUE 0x0100 /* CV return value can be used as lvalue */
#define CVf_CONST 0x0200 /* inlinable sub */
#define CVf_WEAKOUTSIDE 0x0400 /* CvOUTSIDE isn't ref counted */
/* This symbol for optimised communication between toke.c and op.c: */
#define CVf_BUILTIN_ATTRS (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)
#define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE)
#define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE)
#define CvCLONE_off(cv) (CvFLAGS(cv) &= ~CVf_CLONE)
#define CvCLONED(cv) (CvFLAGS(cv) & CVf_CLONED)
#define CvCLONED_on(cv) (CvFLAGS(cv) |= CVf_CLONED)
#define CvCLONED_off(cv) (CvFLAGS(cv) &= ~CVf_CLONED)
#define CvANON(cv) (CvFLAGS(cv) & CVf_ANON)
#define CvANON_on(cv) (CvFLAGS(cv) |= CVf_ANON)
#define CvANON_off(cv) (CvFLAGS(cv) &= ~CVf_ANON)
#ifdef PERL_XSUB_OLDSTYLE
#define CvOLDSTYLE(cv) (CvFLAGS(cv) & CVf_OLDSTYLE)
#define CvOLDSTYLE_on(cv) (CvFLAGS(cv) |= CVf_OLDSTYLE)
#define CvOLDSTYLE_off(cv) (CvFLAGS(cv) &= ~CVf_OLDSTYLE)
#endif
#define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE)
#define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE)
#define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE)
#define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG)
#define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG)
#define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG)
#define CvMETHOD(cv) (CvFLAGS(cv) & CVf_METHOD)
#define CvMETHOD_on(cv) (CvFLAGS(cv) |= CVf_METHOD)
#define CvMETHOD_off(cv) (CvFLAGS(cv) &= ~CVf_METHOD)
#define CvLOCKED(cv) (CvFLAGS(cv) & CVf_LOCKED)
#define CvLOCKED_on(cv) (CvFLAGS(cv) |= CVf_LOCKED)
#define CvLOCKED_off(cv) (CvFLAGS(cv) &= ~CVf_LOCKED)
#define CvLVALUE(cv) (CvFLAGS(cv) & CVf_LVALUE)
#define CvLVALUE_on(cv) (CvFLAGS(cv) |= CVf_LVALUE)
#define CvLVALUE_off(cv) (CvFLAGS(cv) &= ~CVf_LVALUE)
#define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv))
#define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv))
#define CvEVAL_off(cv) CvUNIQUE_off(cv)
/* BEGIN|CHECK|INIT|END */
#define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv))
#define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv))
#define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv))
#define CvCONST(cv) (CvFLAGS(cv) & CVf_CONST)
#define CvCONST_on(cv) (CvFLAGS(cv) |= CVf_CONST)
#define CvCONST_off(cv) (CvFLAGS(cv) &= ~CVf_CONST)
#define CvWEAKOUTSIDE(cv) (CvFLAGS(cv) & CVf_WEAKOUTSIDE)
#define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE)
#define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE)
/*
=head1 CV reference counts and CvOUTSIDE
=for apidoc m|bool|CvWEAKOUTSIDE|CV *cv
Each CV has a pointer, C<CvOUTSIDE()>, to its lexically enclosing
CV (if any). Because pointers to anonymous sub prototypes are
stored in C<&> pad slots, it is a possible to get a circular reference,
with the parent pointing to the child and vice-versa. To avoid the
ensuing memory leak, we do not increment the reference count of the CV
pointed to by C<CvOUTSIDE> in the I<one specific instance> that the parent
has a C<&> pad slot pointing back to us. In this case, we set the
C<CvWEAKOUTSIDE> flag in the child. This allows us to determine under what
circumstances we should decrement the refcount of the parent when freeing
the child.
There is a further complication with non-closure anonymous subs (i.e. those
that do not refer to any lexicals outside that sub). In this case, the
anonymous prototype is shared rather than being cloned. This has the
consequence that the parent may be freed while there are still active
children, eg
BEGIN { $a = sub { eval '$x' } }
In this case, the BEGIN is freed immediately after execution since there
are no active references to it: the anon sub prototype has
C<CvWEAKOUTSIDE> set since it's not a closure, and $a points to the same
CV, so it doesn't contribute to BEGIN's refcount either. When $a is
executed, the C<eval '$x'> causes the chain of C<CvOUTSIDE>s to be followed,
and the freed BEGIN is accessed.
To avoid this, whenever a CV and its associated pad is freed, any
C<&> entries in the pad are explicitly removed from the pad, and if the
refcount of the pointed-to anon sub is still positive, then that
child's C<CvOUTSIDE> is set to point to its grandparent. This will only
occur in the single specific case of a non-closure anon prototype
having one or more active references (such as C<$a> above).
One other thing to consider is that a CV may be merely undefined
rather than freed, eg C<undef &foo>. In this case, its refcount may
not have reached zero, but we still delete its pad and its C<CvROOT> etc.
Since various children may still have their C<CvOUTSIDE> pointing at this
undefined CV, we keep its own C<CvOUTSIDE> for the time being, so that
the chain of lexical scopes is unbroken. For example, the following
should print 123:
my $x = 123;
sub tmp { sub { eval '$x' } }
my $a = tmp();
undef &tmp;
print $a->();
=cut
*/
--- NEW FILE: xsutils.c ---
/* xsutils.c
*
* Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "Perilous to us all are the devices of an art deeper than we possess
* ourselves." --Gandalf
*/
#include "EXTERN.h"
#define PERL_IN_XSUTILS_C
#include "perl.h"
/*
* Contributed by Spider Boardman (spider.boardman at orb.nashua.nh.us).
*/
/* package attributes; */
PERL_XS_EXPORT_C void XS_attributes__warn_reserved(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_attributes_reftype(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_attributes__modify_attrs(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_attributes__guess_stash(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_attributes__fetch_attrs(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_attributes_bootstrap(pTHX_ CV *cv);
/*
* Note that only ${pkg}::bootstrap definitions should go here.
* This helps keep down the start-up time, which is especially
* relevant for users who don't invoke any features which are
* (partially) implemented here.
*
* The various bootstrap definitions can take care of doing
* package-specific newXS() calls. Since the layout of the
* bundled *.pm files is in a version-specific directory,
* version checks in these bootstrap calls are optional.
*/
void
Perl_boot_core_xsutils(pTHX)
{
const char file[] = __FILE__;
newXS("attributes::bootstrap", XS_attributes_bootstrap, (char *)file);
}
#include "XSUB.h"
static int
modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
{
SV *attr;
int nret;
for (nret = 0 ; numattrs && (attr = *attrlist++); numattrs--) {
STRLEN len;
const char *name = SvPV_const(attr, len);
const bool negated = (*name == '-');
if (negated) {
name++;
len--;
}
switch (SvTYPE(sv)) {
case SVt_PVCV:
switch ((int)len) {
#ifdef CVf_ASSERTION
case 9:
if (memEQ(name, "assertion", 9)) {
if (negated)
CvFLAGS((CV*)sv) &= ~CVf_ASSERTION;
else
CvFLAGS((CV*)sv) |= CVf_ASSERTION;
continue;
}
break;
#endif
case 6:
switch (name[3]) {
case 'l':
#ifdef CVf_LVALUE
if (memEQ(name, "lvalue", 6)) {
if (negated)
CvFLAGS((CV*)sv) &= ~CVf_LVALUE;
else
CvFLAGS((CV*)sv) |= CVf_LVALUE;
continue;
}
break;
case 'k':
#endif /* defined CVf_LVALUE */
if (memEQ(name, "locked", 6)) {
if (negated)
CvFLAGS((CV*)sv) &= ~CVf_LOCKED;
else
CvFLAGS((CV*)sv) |= CVf_LOCKED;
continue;
}
break;
case 'h':
if (memEQ(name, "method", 6)) {
if (negated)
CvFLAGS((CV*)sv) &= ~CVf_METHOD;
else
CvFLAGS((CV*)sv) |= CVf_METHOD;
continue;
}
break;
}
break;
}
break;
default:
switch ((int)len) {
case 6:
switch (name[5]) {
case 'd':
if (memEQ(name, "share", 5)) {
if (negated)
Perl_croak(aTHX_ "A variable may not be unshared");
SvSHARE(sv);
continue;
}
break;
case 'e':
if (memEQ(name, "uniqu", 5)) {
if (SvTYPE(sv) == SVt_PVGV) {
if (negated) {
GvUNIQUE_off(sv);
} else {
GvUNIQUE_on(sv);
}
}
/* Hope this came from toke.c if not a GV. */
continue;
}
}
}
break;
}
/* anything recognized had a 'continue' above */
*retlist++ = attr;
nret++;
}
return nret;
}
/* package attributes; */
XS(XS_attributes_bootstrap)
{
dXSARGS;
const char file[] = __FILE__;
if( items > 1 )
Perl_croak(aTHX_ "Usage: attributes::bootstrap $module");
newXSproto("attributes::_warn_reserved", XS_attributes__warn_reserved, (char *)file, "");
newXS("attributes::_modify_attrs", XS_attributes__modify_attrs, (char *)file);
newXSproto("attributes::_guess_stash", XS_attributes__guess_stash, (char *)file, "$");
newXSproto("attributes::_fetch_attrs", XS_attributes__fetch_attrs, (char *)file, "$");
newXSproto("attributes::reftype", XS_attributes_reftype, (char *)file, "$");
XSRETURN(0);
}
XS(XS_attributes__modify_attrs)
{
dXSARGS;
SV *rv, *sv;
if (items < 1) {
usage:
Perl_croak(aTHX_
"Usage: attributes::_modify_attrs $reference, @attributes");
}
rv = ST(0);
if (!(SvOK(rv) && SvROK(rv)))
goto usage;
sv = SvRV(rv);
if (items > 1)
XSRETURN(modify_SV_attributes(aTHX_ sv, &ST(0), &ST(1), items-1));
XSRETURN(0);
}
XS(XS_attributes__fetch_attrs)
{
dXSARGS;
SV *rv, *sv;
cv_flags_t cvflags;
if (items != 1) {
usage:
Perl_croak(aTHX_
"Usage: attributes::_fetch_attrs $reference");
}
rv = ST(0);
SP -= items;
if (!(SvOK(rv) && SvROK(rv)))
goto usage;
sv = SvRV(rv);
switch (SvTYPE(sv)) {
case SVt_PVCV:
cvflags = CvFLAGS((CV*)sv);
if (cvflags & CVf_LOCKED)
XPUSHs(sv_2mortal(newSVpvn("locked", 6)));
#ifdef CVf_LVALUE
if (cvflags & CVf_LVALUE)
XPUSHs(sv_2mortal(newSVpvn("lvalue", 6)));
#endif
if (cvflags & CVf_METHOD)
XPUSHs(sv_2mortal(newSVpvn("method", 6)));
if (GvUNIQUE(CvGV((CV*)sv)))
XPUSHs(sv_2mortal(newSVpvn("unique", 6)));
break;
case SVt_PVGV:
if (GvUNIQUE(sv))
XPUSHs(sv_2mortal(newSVpvn("unique", 6)));
break;
default:
break;
}
PUTBACK;
}
XS(XS_attributes__guess_stash)
{
dXSARGS;
SV *rv, *sv;
dXSTARG;
if (items != 1) {
usage:
Perl_croak(aTHX_
"Usage: attributes::_guess_stash $reference");
}
rv = ST(0);
ST(0) = TARG;
if (!(SvOK(rv) && SvROK(rv)))
goto usage;
sv = SvRV(rv);
if (SvOBJECT(sv))
sv_setpv(TARG, HvNAME_get(SvSTASH(sv)));
#if 0 /* this was probably a bad idea */
else if (SvPADMY(sv))
sv_setsv(TARG, &PL_sv_no); /* unblessed lexical */
#endif
else {
const HV *stash = Nullhv;
switch (SvTYPE(sv)) {
case SVt_PVCV:
if (CvGV(sv) && isGV(CvGV(sv)) && GvSTASH(CvGV(sv)))
stash = GvSTASH(CvGV(sv));
else if (/* !CvANON(sv) && */ CvSTASH(sv))
stash = CvSTASH(sv);
break;
case SVt_PVMG:
if (!(SvFAKE(sv) && SvTIED_mg(sv, PERL_MAGIC_glob)))
break;
/*FALLTHROUGH*/
case SVt_PVGV:
if (GvGP(sv) && GvESTASH((GV*)sv))
stash = GvESTASH((GV*)sv);
break;
default:
break;
}
if (stash)
sv_setpv(TARG, HvNAME_get(stash));
}
SvSETMAGIC(TARG);
XSRETURN(1);
}
XS(XS_attributes_reftype)
{
dXSARGS;
SV *rv, *sv;
dXSTARG;
if (items != 1) {
usage:
Perl_croak(aTHX_
"Usage: attributes::reftype $reference");
}
rv = ST(0);
ST(0) = TARG;
if (SvGMAGICAL(rv))
mg_get(rv);
if (!(SvOK(rv) && SvROK(rv)))
goto usage;
sv = SvRV(rv);
sv_setpv(TARG, sv_reftype(sv, 0));
SvSETMAGIC(TARG);
XSRETURN(1);
}
XS(XS_attributes__warn_reserved)
{
dXSARGS;
if (items != 0) {
Perl_croak(aTHX_
"Usage: attributes::_warn_reserved ()");
}
EXTEND(SP,1);
ST(0) = boolSV(ckWARN(WARN_RESERVED));
XSRETURN(1);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.amiga ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
perlamiga - Perl under Amiga OS
=head1 NOTE
B<Perl 5.8.0 cannot be built in AmigaOS. You can use either the
maintenance release Perl 5.6.1 or the development release Perl 5.7.2
in AmigaOS. See L</"PERL 5.8.0 BROKEN IN AMIGAOS"> if you want to help
fixing this problem.>
=head1 SYNOPSIS
One can read this document in the following formats:
man perlamiga
multiview perlamiga.guide
to list some (not all may be available simultaneously), or it may
be read I<as is>: either as F<README.amiga>, or F<pod/perlamiga.pod>.
A recent version of perl for the Amiga can be found at the Geek Gadgets
section of the Aminet:
http://www.aminet.net/~aminet/dev/gg/index.html
=cut
Contents
perlamiga - Perl under Amiga OS
NAME
SYNOPSIS
DESCRIPTION
- Prerequisites
- Starting Perl programs under AmigaOS
- Shortcomings of Perl under AmigaOS
INSTALLATION
Accessing documentation
- Manpages
- HTML
- GNU info files
- LaTeX docs
BUILD
- Build Prerequisites
- Getting the perl source
- Application of the patches
- Making
- Testing
- Installing the built perl
AUTHOR
SEE ALSO
=head1 DESCRIPTION
=head2 Prerequisites for Compiling Perl on AmigaOS
=over 6
=item B<Unix emulation for AmigaOS: ixemul.library>
You need the Unix emulation for AmigaOS, whose most important part is
B<ixemul.library>. For a minimum setup, get the latest versions
of the following packages from the Aminet archives
( http://www.aminet.net/~aminet/ ):
ixemul-bin
ixemul-env-bin
pdksh-bin
Note also that this is a minimum setup; you might want to add other
packages of B<ADE> (the I<Amiga Developers Environment>).
=item B<Version of Amiga OS>
You need at the very least AmigaOS version 2.0. Recommended is version 3.1.
=back
=head2 Starting Perl programs under AmigaOS
Start your Perl program F<foo> with arguments C<arg1 arg2 arg3> the
same way as on any other platform, by
perl foo arg1 arg2 arg3
If you want to specify perl options C<-my_opts> to the perl itself (as
opposed to your program), use
perl -my_opts foo arg1 arg2 arg3
Alternately, you can try to get a replacement for the system's B<Execute>
command that honors the #!/usr/bin/perl syntax in scripts and set the s-Bit
of your scripts. Then you can invoke your scripts like under UNIX with
foo arg1 arg2 arg3
(Note that having *nixish full path to perl F</usr/bin/perl> is not
necessary, F<perl> would be enough, but having full path would make it
easier to use your script under *nix.)
=head2 Shortcomings of Perl under AmigaOS
Perl under AmigaOS lacks some features of perl under UNIX because of
deficiencies in the UNIX-emulation, most notably:
=over 6
=item *
fork()
=item *
some features of the UNIX filesystem regarding link count and file dates
=item *
inplace operation (the -i switch) without backup file
=item *
umask() works, but the correct permissions are only set when the file is
finally close()d
=back
=head1 INSTALLATION
Change to the installation directory (most probably ADE:), and
extract the binary distribution:
lha -mraxe x perl-$VERSION-bin.lha
or
tar xvzpf perl-$VERSION-bin.tgz
(Of course you need lha or tar and gunzip for this.)
For installation of the Unix emulation, read the appropriate docs.
=head1 Accessing documentation
=head2 Manpages for Perl on AmigaOS
If you have C<man> installed on your system, and you installed perl
manpages, use something like this:
man perlfunc
man less
man ExtUtils.MakeMaker
to access documentation for different components of Perl. Start with
man perl
Note: You have to modify your man.conf file to search for manpages
in the /ade/lib/perl5/man/man3 directory, or the man pages for the
perl library will not be found.
Note that dot (F<.>) is used as a package separator for documentation
for packages, and as usual, sometimes you need to give the section - C<3>
above - to avoid shadowing by the I<less(1) manpage>.
=head2 Perl HTML Documentation on AmigaOS
If you have some WWW browser available, you can build B<HTML> docs.
Cd to directory with F<.pod> files, and do like this
cd /ade/lib/perl5/pod
pod2html
After this you can direct your browser the file F<perl.html> in this
directory, and go ahead with reading docs.
Alternatively you may be able to get these docs prebuilt from C<CPAN>.
=head2 Perl GNU Info Files on AmigaOS
Users of C<Emacs> would appreciate it very much, especially with
C<CPerl> mode loaded. You need to get latest C<pod2info> from C<CPAN>,
or, alternately, prebuilt info pages.
=head2 Perl LaTeX Documentation on AmigaOS
Can be constructed using C<pod2latex>.
=head1 BUILDING PERL ON AMIGAOS
Here we discuss how to build Perl under AmigaOS.
=head2 Build Prerequisites for Perl on AmigaOS
You need to have the latest B<ixemul> (Unix emulation for Amiga)
from Aminet.
=head2 Getting the Perl Source for AmigaOS
You can either get the latest perl-for-amiga source from Ninemoons
and extract it with:
tar xvzpf perl-$VERSION-src.tgz
or get the official source from CPAN:
http://www.cpan.org/src/5.0
Extract it like this
tar xvzpf perl-$VERSION.tar.gz
You will see a message about errors while extracting F<Configure>. This
is normal and expected. (There is a conflict with a similarly-named file
F<configure>, but it causes no harm.)
=head2 Making Perl on AmigaOS
Remember to use a hefty wad of stack (I use 2000000)
sh configure.gnu --prefix=/gg
Now type
make depend
Now!
make
=head2 Testing Perl on AmigaOS
Now run
make test
Some tests will be skipped because they need the fork() function:
F<io/pipe.t>, F<op/fork.t>, F<lib/filehand.t>, F<lib/open2.t>, F<lib/open3.t>,
F<lib/io_pipe.t>, F<lib/io_sock.t>
=head2 Installing the built Perl on AmigaOS
Run
make install
=head1 PERL 5.8.0 BROKEN IN AMIGAOS
As told above, Perl 5.6.1 was still good in AmigaOS, as was 5.7.2.
After Perl 5.7.2 (change #11423, see the Changes file, and the file
pod/perlhack.pod for how to get the individual changes) Perl dropped
its internal support for vfork(), and that was very probably the step
that broke AmigaOS (since the ixemul library has only vfork).
The build finally fails when the ext/DynaLoader is being built, and
PERL ends up as "0" in the produced Makefile, trying to run "0" does
not quite work. Also, executing miniperl in backticks seems to
generate nothing: very probably related to the (v)fork problems.
B<Fixing the breakage requires someone quite familiar with the ixemul
library, and how one is supposed to run external commands in AmigaOS
without fork().>
=head1 AUTHORS
Norbert Pueschel, pueschel at imsdd.meb.uni-bonn.de
Jan-Erik Karlsson, trg at privat.utfors.se
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE: pp.sym ---
# -*- buffer-read-only: t -*-
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by opcode.pl from its data. Any changes made here
# will be lost!
#
Perl_ck_anoncode
Perl_ck_bitop
Perl_ck_concat
Perl_ck_defined
Perl_ck_delete
Perl_ck_die
Perl_ck_eof
Perl_ck_eval
Perl_ck_exec
Perl_ck_exists
Perl_ck_exit
Perl_ck_ftst
Perl_ck_fun
Perl_ck_glob
Perl_ck_grep
Perl_ck_index
Perl_ck_join
Perl_ck_lengthconst
Perl_ck_lfun
Perl_ck_listiob
Perl_ck_match
Perl_ck_method
Perl_ck_null
Perl_ck_open
Perl_ck_repeat
Perl_ck_require
Perl_ck_return
Perl_ck_rfun
Perl_ck_rvconst
Perl_ck_sassign
Perl_ck_select
Perl_ck_shift
Perl_ck_sort
Perl_ck_spair
Perl_ck_split
Perl_ck_subr
Perl_ck_substr
Perl_ck_svconst
Perl_ck_trunc
Perl_pp_null
Perl_pp_stub
Perl_pp_scalar
Perl_pp_pushmark
Perl_pp_wantarray
Perl_pp_const
Perl_pp_gvsv
Perl_pp_gv
Perl_pp_gelem
Perl_pp_padsv
Perl_pp_padav
Perl_pp_padhv
Perl_pp_padany
Perl_pp_pushre
Perl_pp_rv2gv
Perl_pp_rv2sv
Perl_pp_av2arylen
Perl_pp_rv2cv
Perl_pp_anoncode
Perl_pp_prototype
Perl_pp_refgen
Perl_pp_srefgen
Perl_pp_ref
Perl_pp_bless
Perl_pp_backtick
Perl_pp_glob
Perl_pp_readline
Perl_pp_rcatline
Perl_pp_regcmaybe
Perl_pp_regcreset
Perl_pp_regcomp
Perl_pp_match
Perl_pp_qr
Perl_pp_subst
Perl_pp_substcont
Perl_pp_trans
Perl_pp_sassign
Perl_pp_aassign
Perl_pp_chop
Perl_pp_schop
Perl_pp_chomp
Perl_pp_schomp
Perl_pp_defined
Perl_pp_undef
Perl_pp_study
Perl_pp_pos
Perl_pp_preinc
Perl_pp_predec
Perl_pp_postinc
Perl_pp_postdec
Perl_pp_pow
Perl_pp_multiply
Perl_pp_i_multiply
Perl_pp_divide
Perl_pp_i_divide
Perl_pp_modulo
Perl_pp_i_modulo
Perl_pp_repeat
Perl_pp_add
Perl_pp_i_add
Perl_pp_subtract
Perl_pp_i_subtract
Perl_pp_concat
Perl_pp_stringify
Perl_pp_left_shift
Perl_pp_right_shift
Perl_pp_lt
Perl_pp_i_lt
Perl_pp_gt
Perl_pp_i_gt
Perl_pp_le
Perl_pp_i_le
Perl_pp_ge
Perl_pp_i_ge
Perl_pp_eq
Perl_pp_i_eq
Perl_pp_ne
Perl_pp_i_ne
Perl_pp_ncmp
Perl_pp_i_ncmp
Perl_pp_slt
Perl_pp_sgt
Perl_pp_sle
Perl_pp_sge
Perl_pp_seq
Perl_pp_sne
Perl_pp_scmp
Perl_pp_bit_and
Perl_pp_bit_xor
Perl_pp_bit_or
Perl_pp_negate
Perl_pp_i_negate
Perl_pp_not
Perl_pp_complement
Perl_pp_atan2
Perl_pp_sin
Perl_pp_cos
Perl_pp_rand
Perl_pp_srand
Perl_pp_exp
Perl_pp_log
Perl_pp_sqrt
Perl_pp_int
Perl_pp_hex
Perl_pp_oct
Perl_pp_abs
Perl_pp_length
Perl_pp_substr
Perl_pp_vec
Perl_pp_index
Perl_pp_rindex
Perl_pp_sprintf
Perl_pp_formline
Perl_pp_ord
Perl_pp_chr
Perl_pp_crypt
Perl_pp_ucfirst
Perl_pp_lcfirst
Perl_pp_uc
Perl_pp_lc
Perl_pp_quotemeta
Perl_pp_rv2av
Perl_pp_aelemfast
Perl_pp_aelem
Perl_pp_aslice
Perl_pp_each
Perl_pp_values
Perl_pp_keys
Perl_pp_delete
Perl_pp_exists
Perl_pp_rv2hv
Perl_pp_helem
Perl_pp_hslice
Perl_pp_unpack
Perl_pp_pack
Perl_pp_split
Perl_pp_join
Perl_pp_list
Perl_pp_lslice
Perl_pp_anonlist
Perl_pp_anonhash
Perl_pp_splice
Perl_pp_push
Perl_pp_pop
Perl_pp_shift
Perl_pp_unshift
Perl_pp_sort
Perl_pp_reverse
Perl_pp_grepstart
Perl_pp_grepwhile
Perl_pp_mapstart
Perl_pp_mapwhile
Perl_pp_range
Perl_pp_flip
Perl_pp_flop
Perl_pp_and
Perl_pp_or
Perl_pp_xor
Perl_pp_cond_expr
Perl_pp_andassign
Perl_pp_orassign
Perl_pp_method
Perl_pp_entersub
Perl_pp_leavesub
Perl_pp_leavesublv
Perl_pp_caller
Perl_pp_warn
Perl_pp_die
Perl_pp_reset
Perl_pp_lineseq
Perl_pp_nextstate
Perl_pp_dbstate
Perl_pp_unstack
Perl_pp_enter
Perl_pp_leave
Perl_pp_scope
Perl_pp_enteriter
Perl_pp_iter
Perl_pp_enterloop
Perl_pp_leaveloop
Perl_pp_return
Perl_pp_last
Perl_pp_next
Perl_pp_redo
Perl_pp_dump
Perl_pp_goto
Perl_pp_exit
Perl_pp_open
Perl_pp_close
Perl_pp_pipe_op
Perl_pp_fileno
Perl_pp_umask
Perl_pp_binmode
Perl_pp_tie
Perl_pp_untie
Perl_pp_tied
Perl_pp_dbmopen
Perl_pp_dbmclose
Perl_pp_sselect
Perl_pp_select
Perl_pp_getc
Perl_pp_read
Perl_pp_enterwrite
Perl_pp_leavewrite
Perl_pp_prtf
Perl_pp_print
Perl_pp_sysopen
Perl_pp_sysseek
Perl_pp_sysread
Perl_pp_syswrite
Perl_pp_send
Perl_pp_recv
Perl_pp_eof
Perl_pp_tell
Perl_pp_seek
Perl_pp_truncate
Perl_pp_fcntl
Perl_pp_ioctl
Perl_pp_flock
Perl_pp_socket
Perl_pp_sockpair
Perl_pp_bind
Perl_pp_connect
Perl_pp_listen
Perl_pp_accept
Perl_pp_shutdown
Perl_pp_gsockopt
Perl_pp_ssockopt
Perl_pp_getsockname
Perl_pp_getpeername
Perl_pp_lstat
Perl_pp_stat
Perl_pp_ftrread
Perl_pp_ftrwrite
Perl_pp_ftrexec
Perl_pp_fteread
Perl_pp_ftewrite
Perl_pp_fteexec
Perl_pp_ftis
Perl_pp_fteowned
Perl_pp_ftrowned
Perl_pp_ftzero
Perl_pp_ftsize
Perl_pp_ftmtime
Perl_pp_ftatime
Perl_pp_ftctime
Perl_pp_ftsock
Perl_pp_ftchr
Perl_pp_ftblk
Perl_pp_ftfile
Perl_pp_ftdir
Perl_pp_ftpipe
Perl_pp_ftlink
Perl_pp_ftsuid
Perl_pp_ftsgid
Perl_pp_ftsvtx
Perl_pp_fttty
Perl_pp_fttext
Perl_pp_ftbinary
Perl_pp_chdir
Perl_pp_chown
Perl_pp_chroot
Perl_pp_unlink
Perl_pp_chmod
Perl_pp_utime
Perl_pp_rename
Perl_pp_link
Perl_pp_symlink
Perl_pp_readlink
Perl_pp_mkdir
Perl_pp_rmdir
Perl_pp_open_dir
Perl_pp_readdir
Perl_pp_telldir
Perl_pp_seekdir
Perl_pp_rewinddir
Perl_pp_closedir
Perl_pp_fork
Perl_pp_wait
Perl_pp_waitpid
Perl_pp_system
Perl_pp_exec
Perl_pp_kill
Perl_pp_getppid
Perl_pp_getpgrp
Perl_pp_setpgrp
Perl_pp_getpriority
Perl_pp_setpriority
Perl_pp_time
Perl_pp_tms
Perl_pp_localtime
Perl_pp_gmtime
Perl_pp_alarm
Perl_pp_sleep
Perl_pp_shmget
Perl_pp_shmctl
Perl_pp_shmread
Perl_pp_shmwrite
Perl_pp_msgget
Perl_pp_msgctl
Perl_pp_msgsnd
Perl_pp_msgrcv
Perl_pp_semget
Perl_pp_semctl
Perl_pp_semop
Perl_pp_require
Perl_pp_dofile
Perl_pp_entereval
Perl_pp_leaveeval
Perl_pp_entertry
Perl_pp_leavetry
Perl_pp_ghbyname
Perl_pp_ghbyaddr
Perl_pp_ghostent
Perl_pp_gnbyname
Perl_pp_gnbyaddr
Perl_pp_gnetent
Perl_pp_gpbyname
Perl_pp_gpbynumber
Perl_pp_gprotoent
Perl_pp_gsbyname
Perl_pp_gsbyport
Perl_pp_gservent
Perl_pp_shostent
Perl_pp_snetent
Perl_pp_sprotoent
Perl_pp_sservent
Perl_pp_ehostent
Perl_pp_enetent
Perl_pp_eprotoent
Perl_pp_eservent
Perl_pp_gpwnam
Perl_pp_gpwuid
Perl_pp_gpwent
Perl_pp_spwent
Perl_pp_epwent
Perl_pp_ggrnam
Perl_pp_ggrgid
Perl_pp_ggrent
Perl_pp_sgrent
Perl_pp_egrent
Perl_pp_getlogin
Perl_pp_syscall
Perl_pp_lock
Perl_pp_threadsv
Perl_pp_setstate
Perl_pp_method_named
# ex: set ro:
--- NEW FILE: reentr.pl ---
#!/usr/bin/perl -w
#
# Generate the reentr.c and reentr.h,
# and optionally also the relevant metaconfig units (-U option).
#
BEGIN {
# Get function prototypes
require 'regen_lib.pl';
}
use strict;
use Getopt::Std;
my %opts;
getopts('U', \%opts);
my %map = (
V => "void",
[...1160 lines suppressed...]
getservbyport S_IC |netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
getservent S_V |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
getspnam S_C |shadow |struct spwd |I_CSBWR|S_CSBI
gmtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
localtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
random L_V |stdlib |struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
readdir S_T |dirent |struct dirent |I_TSR|I_TS|T=DIR*
readdir64 S_T |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
setgrent |grp | |I_H|V_H
sethostent V_I |netdb | |I_ID|V_ID|D=struct hostent_data*
setlocale B_IC |locale | |I_ICBI
setnetent V_I |netdb | |I_ID|V_ID|D=struct netent_data*
setprotoent V_I |netdb | |I_ID|V_ID|D=struct protoent_data*
setpwent |pwd | |I_H|V_H
setservent V_I |netdb | |I_ID|V_ID|D=struct servent_data*
srand48 V_L |stdlib |struct drand48_data |I_LS
srandom V_T |stdlib |struct random_data|I_TS|T=unsigned int
strerror B_I |string | |I_IBW|I_IBI|B_IBW
tmpnam B_B |stdio | |B_B
ttyname B_I |unistd | |I_IBW|I_IBI|B_IBI
--- NEW FILE: README.aix ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.aix - Perl version 5 on IBM Unix (AIX) systems
=head1 DESCRIPTION
This document describes various features of IBM's Unix operating
system (AIX) that will affect how Perl version 5 (hereafter just Perl)
is compiled and/or runs.
=head2 Compiling Perl 5 on AIX
When compiling Perl, you must use an ANSI C compiler. AIX does not ship
an ANSI compliant C-compiler with AIX by default, but binary builds of
gcc for AIX are widely available.
At the moment of writing, AIX supports two different native C compilers,
for which you have to pay: B<xlC> and B<vac>. If you decide to use either
of these two (which is quite a lot easier than using gcc), be sure to
upgrade to the latest available patch level. Currently:
xlC.C 3.1.4.10 or 3.6.6.0 or 4.0.2.2 or 5.0.2.9 or 6.0.0.3
vac.C 4.4.0.3 or 5.0.2.6 or 6.0.0.1
note that xlC has the OS version in the name as of version 4.0.2.0, so
you will find xlC.C for AIX-5.0 as package
xlC.aix50.rte 5.0.2.0 or 6.0.0.3
subversions are not the same "latest" on all OS versions. For example,
the latest xlC-5 on aix41 is 5.0.2.9, while on aix43, it is 5.0.2.7.
Perl can be compiled with either IBM's ANSI C compiler or with gcc.
The former is recommended, as not only can it compile Perl with no
difficulty, but also can take advantage of features listed later that
require the use of IBM compiler-specific command-line flags.
The IBM's compiler patch levels 5.0.0.0 and 5.0.1.0 have compiler
optimization bugs that affect compiling perl.c and regcomp.c,
respectively. If Perl's configuration detects those compiler patch
levels, optimization is turned off for the said source code files.
Upgrading to at least 5.0.2.0 is recommended.
If you decide to use gcc, make sure your installation is recent and
complete, and be sure to read the Perl README file for more gcc-specific
details. Please report any hoops you had to jump through to the development
team.
=head2 OS level
Before installing the patches to the IBM C-compiler you need to know the
level of patching for the Operating System. IBM's command 'oslevel' will
show the base, but is not always complete (in this example oslevel shows
4.3.NULL, whereas the system might run most of 4.3.THREE):
# oslevel
4.3.0.0
# lslpp -l | grep 'bos.rte '
bos.rte 4.3.3.75 COMMITTED Base Operating System Runtime
bos.rte 4.3.2.0 COMMITTED Base Operating System Runtime
#
The same might happen to AIX 5.1 or other OS levels. As a side note, perl
cannot be built without bos.adt.syscalls and bos.adt.libm installed
# lslpp -l | egrep "syscalls|libm"
bos.adt.libm 5.1.0.25 COMMITTED Base Application Development
bos.adt.syscalls 5.1.0.36 COMMITTED System Calls Application
#
=head2 Building Dynamic Extensions on AIX
AIX supports dynamically loadable objects as well as shared libraries.
Shared libraries by convention end with the suffix .a, which is a bit
misleading, as an archive can contain static as well as dynamic members.
For perl dynamically loaded objects we use the .so suffix also used on
many other platforms.
Note that starting from Perl 5.7.2 (and consequently 5.8.0) and AIX 4.3
or newer Perl uses the AIX native dynamic loading interface in the so
called runtime linking mode instead of the emulated interface that was
used in Perl releases 5.6.1 and earlier or, for AIX releases 4.2 and
earlier. This change does break backward compatibility with compiled
modules from earlier perl releases. The change was made to make Perl
more compliant with other applications like Apache/mod_perl which are
using the AIX native interface. This change also enables the use of C++
code with static constructors and destructors in perl extensions, which
was not possible using the emulated interface.
=head2 The IBM ANSI C Compiler
All defaults for Configure can be used.
If you've chosen to use vac 4, be sure to run 4.4.0.3. Older versions
will turn up nasty later on. For vac 5 be sure to run at least 5.0.1.0,
but vac 5.0.2.6 or up is highly recommended. Note that since IBM has
removed vac 5.0.2.1 through 5.0.2.5 from the software depot, these
versions should be considered obsolete.
Here's a brief lead of how to upgrade the compiler to the latest
level. Of course this is subject to changes. You can only upgrade
versions from ftp-available updates if the first three digit groups
are the same (in where you can skip intermediate unlike the patches
in the developer snapshots of perl), or to one version up where the
"base" is available. In other words, the AIX compiler patches are
cumulative.
vac.C.4.4.0.1 => vac.C.4.4.0.3 is OK (vac.C.4.4.0.2 not needed)
xlC.C.3.1.3.3 => xlC.C.3.1.4.10 is NOT OK (xlC.C.3.1.4.0 is not available)
# ftp ftp.software.ibm.com
Connected to service.boulder.ibm.com.
: welcome message ...
Name (ftp.software.ibm.com:merijn): anonymous
331 Guest login ok, send your complete e-mail address as password.
Password:
... accepted login stuff
ftp> cd /aix/fixes/v4/
ftp> dir other other.ll
output to local-file: other.ll? y
200 PORT command successful.
150 Opening ASCII mode data connection for /bin/ls.
226 Transfer complete.
ftp> dir xlc xlc.ll
output to local-file: xlc.ll? y
200 PORT command successful.
150 Opening ASCII mode data connection for /bin/ls.
226 Transfer complete.
ftp> bye
... goodbye messages
# ls -l *.ll
-rw-rw-rw- 1 merijn system 1169432 Nov 2 17:29 other.ll
-rw-rw-rw- 1 merijn system 29170 Nov 2 17:29 xlc.ll
On AIX 4.2 using xlC, we continue:
# lslpp -l | fgrep 'xlC.C '
xlC.C 3.1.4.9 COMMITTED C for AIX Compiler
xlC.C 3.1.4.0 COMMITTED C for AIX Compiler
# grep 'xlC.C.3.1.4.*.bff' xlc.ll
-rw-r--r-- 1 45776101 1 6286336 Jul 22 1996 xlC.C.3.1.4.1.bff
-rw-rw-r-- 1 45776101 1 6173696 Aug 24 1998 xlC.C.3.1.4.10.bff
-rw-r--r-- 1 45776101 1 6319104 Aug 14 1996 xlC.C.3.1.4.2.bff
-rw-r--r-- 1 45776101 1 6316032 Oct 21 1996 xlC.C.3.1.4.3.bff
-rw-r--r-- 1 45776101 1 6315008 Dec 20 1996 xlC.C.3.1.4.4.bff
-rw-rw-r-- 1 45776101 1 6178816 Mar 28 1997 xlC.C.3.1.4.5.bff
-rw-rw-r-- 1 45776101 1 6188032 May 22 1997 xlC.C.3.1.4.6.bff
-rw-rw-r-- 1 45776101 1 6191104 Sep 5 1997 xlC.C.3.1.4.7.bff
-rw-rw-r-- 1 45776101 1 6185984 Jan 13 1998 xlC.C.3.1.4.8.bff
-rw-rw-r-- 1 45776101 1 6169600 May 27 1998 xlC.C.3.1.4.9.bff
# wget ftp://ftp.software.ibm.com/aix/fixes/v4/xlc/xlC.C.3.1.4.10.bff
#
On AIX 4.3 using vac, we continue:
# lslpp -l | grep 'vac.C '
vac.C 5.0.2.2 COMMITTED C for AIX Compiler
vac.C 5.0.2.0 COMMITTED C for AIX Compiler
# grep 'vac.C.5.0.2.*.bff' other.ll
-rw-rw-r-- 1 45776101 1 13592576 Apr 16 2001 vac.C.5.0.2.0.bff
-rw-rw-r-- 1 45776101 1 14133248 Apr 9 2002 vac.C.5.0.2.3.bff
-rw-rw-r-- 1 45776101 1 14173184 May 20 2002 vac.C.5.0.2.4.bff
-rw-rw-r-- 1 45776101 1 14192640 Nov 22 2002 vac.C.5.0.2.6.bff
# wget ftp://ftp.software.ibm.com/aix/fixes/v4/other/vac.C.5.0.2.6.bff
#
Likewise on all other OS levels. Then execute the following command, and
fill in its choices
# smit install_update
-> Install and Update from LATEST Available Software
* INPUT device / directory for software [ vac.C.5.0.2.6.bff ]
[ OK ]
[ OK ]
Follow the messages ... and you're done.
If you like a more web-like approach, a good start point can be
http://www14.software.ibm.com/webapp/download/downloadaz.jsp and click
"C for AIX", and follow the instructions.
=head2 The usenm option
If linking miniperl
cc -o miniperl ... miniperlmain.o opmini.o perl.o ... -lm -lc ...
causes error like this
ld: 0711-317 ERROR: Undefined symbol: .aintl
ld: 0711-317 ERROR: Undefined symbol: .copysignl
ld: 0711-317 ERROR: Undefined symbol: .syscall
ld: 0711-317 ERROR: Undefined symbol: .eaccess
ld: 0711-317 ERROR: Undefined symbol: .setresuid
ld: 0711-317 ERROR: Undefined symbol: .setresgid
ld: 0711-317 ERROR: Undefined symbol: .setproctitle
ld: 0711-345 Use the -bloadmap or -bnoquiet option to obtain more information.
you could retry with
make realclean
rm config.sh
./Configure -Dusenm ...
which makes Configure to use the C<nm> tool when scanning for library
symbols, which usually is not done in AIX.
Related to this, you probably should not use the C<-r> option of
Configure in AIX, because that affects of how the C<nm> tool is used.
=head2 Using GNU's gcc for building perl
Using gcc-3.x (tested with 3.0.4, 3.1, and 3.2) now works out of the box,
as do recent gcc-2.9 builds available directly from IBM as part of their
Linux compatibility packages, available here:
http://www.ibm.com/servers/aix/products/aixos/linux/
=head2 Using Large Files with Perl
Should yield no problems.
=head2 Threaded Perl
Threads seem to work OK, though at the moment not all tests pass when
threads are used in combination with 64-bit configurations.
You may get a warning when doing a threaded build:
"pp_sys.c", line 4640.39: 1506-280 (W) Function argument assignment between types "unsigned char*" and "const void*" is not allowed.
The exact line number may vary, but if the warning (W) comes from a line
line this
hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
in the "pp_ghostent" function, you may ignore it safely. The warning
is caused by the reentrant variant of gethostbyaddr() having a slightly
different prototype than its non-reentrant variant, but the difference
is not really significant here.
=head2 64-bit Perl
If your AIX is installed with 64-bit support, you can expect 64-bit
configurations to work. In combination with threads some tests might
still fail.
=head2 AIX 4.2 and extensions using C++ with statics
In AIX 4.2 Perl extensions that use C++ functions that use statics
may have problems in that the statics are not getting initialized.
In newer AIX releases this has been solved by linking Perl with
the libC_r library, but unfortunately in AIX 4.2 the said library
has an obscure bug where the various functions related to time
(such as time() and gettimeofday()) return broken values, and
therefore in AIX 4.2 Perl is not linked against the libC_r.
=head1 AUTHOR
H.Merijn Brand <h.m.brand at xs4all.nl>
=head1 DATE
Version 0.0.6: 23 Dec 2002
=cut
--- NEW FILE: pp_hot.c ---
/* pp_hot.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Then he heard Merry change the note, and up went the Horn-cry of Buckland,
* shaking the air.
*
* Awake! Awake! Fear, Fire, Foes! Awake!
* Fire, Foes! Awake!
*/
/* This file contains 'hot' pp ("push/pop") functions that
[...3246 lines suppressed...]
MUTEX_LOCK(CvMUTEXP(cv));
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
CvDEPTH(cv)));
assert(thr == CvOWNER(cv));
CvOWNER(cv) = 0;
MUTEX_UNLOCK(CvMUTEXP(cv));
SvREFCNT_dec(cv);
}
#endif /* USE_5005THREADS */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: Changes5.8.7 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...3803 lines suppressed...]
From: Abe Timmerman <abe at ztreet.demon.nl>
Date: Sun, 14 Nov 2004 00:48:17 +0100
Message-Id: <200411140048.17035.abe at ztreet.demon.nl>
Branch: maint-5.8/perl
!> vms/descrip_mms.template vms/test.com
____________________________________________________________________________
[ 23559] By: nicholas on 2004/11/28 00:09:35
Log: Disarm the maint branch
Branch: maint-5.8/perl
! patchlevel.h
____________________________________________________________________________
[ 23556] By: nicholas on 2004/11/27 18:34:58
Log: Break a leg
Branch: maint-5.8/perl
! patchlevel.h pod/perlhist.pod
____________________________________________________________________________
[ 23553] By: nicholas on 2004/11/27 15:49:55
Log: Update Changes
Branch: maint-5.8/perl
! Changes patchlevel.h
--- NEW FILE: malloc.c ---
/* malloc.c
*
*/
/*
* "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'"
*/
/* This file contains Perl's own implementation of the malloc library.
* It is used if Configure decides that, on your platform, Perl's
* version is better than the OS's, or if you give Configure the
* -Dusemymalloc command-line option.
*/
/*
Here are some notes on configuring Perl's malloc. (For non-perl
usage see below.)
There are two macros which serve as bulk disablers of advanced
[...2543 lines suppressed...]
}
}
DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n",
size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
return (void *)got;
}
#endif /* ! defined USE_PERL_SBRK */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.hurd ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.hurd - Perl version 5 on Hurd
=head1 DESCRIPTION
If you want to use Perl on the Hurd, I recommend using the Debian
GNU/Hurd distribution ( see http://www.debian.org/ ), even if an
official, stable release has not yet been made. The old "gnu-0.2"
binary distribution will most certainly have additional problems.
=head2 Known Problems with Perl on Hurd
The Perl test suite may still report some errors on the Hurd. The
"lib/anydbm" and "pragma/warnings" tests will almost certainly fail.
Both failures are not really specific to the Hurd, as indicated by the
test suite output.
The socket tests may fail if the network is not configured. You have
to make "/hurd/pfinet" the translator for "/servers/socket/2", giving
it the right arguments. Try "/hurd/pfinet --help" for more
information.
Here are the statistics for Perl 5.005_62 on my system:
Failed Test Status Wstat Total Fail Failed List of failed
-------------------------------------------------------------------------
lib/anydbm.t 12 1 8.33% 12
pragma/warnings 333 1 0.30% 215
8 tests and 24 subtests skipped.
Failed 2/229 test scripts, 99.13% okay. 2/10850 subtests failed, 99.98% okay.
There are quite a few systems out there that do worse!
However, since I am running a very recent Hurd snapshot, in which a lot of
bugs that were exposed by the Perl test suite have been fixed, you may
encounter more failures. Likely candidates are: "op/stat", "lib/io_pipe",
"lib/io_sock", "lib/io_udp" and "lib/time".
In any way, if you're seeing failures beyond those mentioned in this
document, please consider upgrading to the latest Hurd before reporting
the failure as a bug.
=head1 AUTHOR
Mark Kettenis <kettenis at gnu.org>
Last Updated: Fri, 29 Oct 1999 22:50:30 +0200
--- NEW FILE: Artistic ---
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
--- NEW FILE: regcomp.sym ---
# Format:
# NAME \t TYPE, arg-description [num-args] [longjump-len] \t DESCRIPTION
# Empty rows and #-comment rows are ignored.
# Exit points
END END, no End of program.
SUCCEED END, no Return from a subroutine, basically.
# Anchors:
BOL BOL, no Match "" at beginning of line.
MBOL BOL, no Same, assuming multiline.
SBOL BOL, no Same, assuming singleline.
EOS EOL, no Match "" at end of string.
EOL EOL, no Match "" at end of line.
MEOL EOL, no Same, assuming multiline.
SEOL EOL, no Same, assuming singleline.
BOUND BOUND, no Match "" at any word boundary
BOUNDL BOUND, no Match "" at any word boundary
NBOUND NBOUND, no Match "" at any word non-boundary
NBOUNDL NBOUND, no Match "" at any word non-boundary
GPOS GPOS, no Matches where last m//g left off.
# [Special] alternatives
REG_ANY REG_ANY, no Match any one character (except newline).
SANY REG_ANY, no Match any one character.
CANY REG_ANY, no Match any one byte.
ANYOF ANYOF, sv Match character in (or not in) this class.
ALNUM ALNUM, no Match any alphanumeric character
ALNUML ALNUM, no Match any alphanumeric char in locale
NALNUM NALNUM, no Match any non-alphanumeric character
NALNUML NALNUM, no Match any non-alphanumeric char in locale
SPACE SPACE, no Match any whitespace character
SPACEL SPACE, no Match any whitespace char in locale
NSPACE NSPACE, no Match any non-whitespace character
NSPACEL NSPACE, no Match any non-whitespace char in locale
DIGIT DIGIT, no Match any numeric character
DIGITL DIGIT, no Match any numeric character in locale
NDIGIT NDIGIT, no Match any non-numeric character
NDIGITL NDIGIT, no Match any non-numeric character in locale
CLUMP CLUMP, no Match any combining character sequence
# BRANCH The set of branches constituting a single choice are hooked
# together with their "next" pointers, since precedence prevents
# anything being concatenated to any individual branch. The
# "next" pointer of the last BRANCH in a choice points to the
# thing following the whole choice. This is also where the
# final "next" pointer of each individual branch points; each
# branch starts with the operand node of a BRANCH node.
#
BRANCH BRANCH, node Match this alternative, or the next...
# BACK Normal "next" pointers all implicitly point forward; BACK
# exists to make loop structures possible.
# not used
BACK BACK, no Match "", "next" ptr points backward.
# Literals
EXACT EXACT, sv Match this string (preceded by length).
EXACTF EXACT, sv Match this string, folded (prec. by length).
EXACTFL EXACT, sv Match this string, folded in locale (w/len).
# Do nothing
NOTHING NOTHING,no Match empty string.
# A variant of above which delimits a group, thus stops optimizations
TAIL NOTHING,no Match empty string. Can jump here from outside.
# STAR,PLUS '?', and complex '*' and '+', are implemented as circular
# BRANCH structures using BACK. Simple cases (one character
# per match) are implemented with STAR and PLUS for speed
# and to minimize recursive plunges.
#
STAR STAR, node Match this (simple) thing 0 or more times.
PLUS PLUS, node Match this (simple) thing 1 or more times.
CURLY CURLY, sv 2 Match this simple thing {n,m} times.
CURLYN CURLY, no 2 Match next-after-this simple thing
# {n,m} times, set parenths.
CURLYM CURLY, no 2 Match this medium-complex thing {n,m} times.
CURLYX CURLY, sv 2 Match this complex thing {n,m} times.
# This terminator creates a loop structure for CURLYX
WHILEM WHILEM, no Do curly processing and see if rest matches.
# OPEN,CLOSE,GROUPP ...are numbered at compile time.
OPEN OPEN, num 1 Mark this point in input as start of #n.
CLOSE CLOSE, num 1 Analogous to OPEN.
REF REF, num 1 Match some already matched string
REFF REF, num 1 Match already matched string, folded
REFFL REF, num 1 Match already matched string, folded in loc.
# grouping assertions
IFMATCH BRANCHJ,off 1 2 Succeeds if the following matches.
UNLESSM BRANCHJ,off 1 2 Fails if the following matches.
SUSPEND BRANCHJ,off 1 1 "Independent" sub-RE.
IFTHEN BRANCHJ,off 1 1 Switch, should be preceeded by switcher .
GROUPP GROUPP, num 1 Whether the group matched.
# Support for long RE
LONGJMP LONGJMP,off 1 1 Jump far away.
BRANCHJ BRANCHJ,off 1 1 BRANCH with long offset.
# The heavy worker
EVAL EVAL, evl 1 Execute some Perl code.
# Modifiers
MINMOD MINMOD, no Next operator is not greedy.
LOGICAL LOGICAL,no Next opcode should set the flag only.
# This is not used yet
RENUM BRANCHJ,off 1 1 Group with independently numbered parens.
# This is not really a node, but an optimized away piece of a "long" node.
# To simplify debugging output, we mark it as if it were a node
OPTIMIZED NOTHING,off Placeholder for dump.
--- NEW FILE: README.linux ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
README.linux - Perl version 5 on Linux systems
=head1 DESCRIPTION
This document describes various features of Linux that will affect how Perl
version 5 (hereafter just Perl) is compiled and/or runs.
=head2 Experimental Support for Sun Studio Compilers for Linux OS
Sun Microsystems has released a port of their Sun Studio compiliers for
Linux. As of November 2005, only an alpha version has been released.
Until a release of these compilers is made, support for compiling Perl with
these compiler experimental.
Also, some special instructions for building Perl with Sun Studio on Linux.
Following the normal C<Configure>, you have to run make as follows:
LDLOADLIBS=-lc make
C<LDLOADLIBS> is an environment variable used by the linker to link modules
C</ext> modules to glibc. Currently, that environment variable is not getting
populated by a combination of C<Config> entries and C<ExtUtil::MakeMaker>.
While there may be a bug somewhere in Perl's configuration or
C<ExtUtil::MakeMaker> causing the problem, the most likely cause is an
incomplete understanding of Sun Studio by this author. Further investigation
is needed to get this working better.
=head1 AUTHOR
Steve Peters <steve at fisharerojo.org>
Please report any errors, updates, or suggestions to F<perlbug at perl.org>.
--- NEW FILE: fakesdio.h ---
/* fakestdio.h
*
* Copyright (C) 2000, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* This is "source level" stdio compatibility mode.
* We try and #define stdio functions in terms of PerlIO.
*/
#define _CANNOT "CANNOT"
#undef FILE
#define FILE PerlIO
#undef clearerr
#undef fclose
#undef fdopen
#undef feof
#undef ferror
#undef fflush
#undef fgetc
#undef fgetpos
#undef fgets
#undef fileno
#undef flockfile
#undef fopen
#undef fprintf
#undef fputc
#undef fputs
#undef fread
#undef freopen
#undef fscanf
#undef fseek
#undef fsetpos
#undef ftell
#undef ftrylockfile
#undef funlockfile
#undef fwrite
#undef getc
#undef getc_unlocked
#undef getw
#undef pclose
#undef popen
#undef putc
#undef putc_unlocked
#undef putw
#undef rewind
#undef setbuf
#undef setvbuf
#undef stderr
#undef stdin
#undef stdout
#undef tmpfile
#undef ungetc
#undef vfprintf
#undef printf
/* printf used to live in perl.h like this - more sophisticated
than the rest
*/
#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
#define printf(fmt,args...) PerlIO_stdoutf(fmt,##args)
#else
#define printf PerlIO_stdoutf
#endif
#endif
#define fprintf PerlIO_printf
#define stdin PerlIO_stdin()
#define stdout PerlIO_stdout()
#define stderr PerlIO_stderr()
#define tmpfile() PerlIO_tmpfile()
#define fclose(f) PerlIO_close(f)
#define fflush(f) PerlIO_flush(f)
#define fopen(p,m) PerlIO_open(p,m)
#define vfprintf(f,fmt,a) PerlIO_vprintf(f,fmt,a)
#define fgetc(f) PerlIO_getc(f)
#define fputc(c,f) PerlIO_putc(f,c)
#define fputs(s,f) PerlIO_puts(f,s)
#define getc(f) PerlIO_getc(f)
#define getc_unlocked(f) PerlIO_getc(f)
#define putc(c,f) PerlIO_putc(f,c)
#define putc_unlocked(c,f) PerlIO_putc(c,f)
#define ungetc(c,f) PerlIO_ungetc(f,c)
#if 0
/* return values of read/write need work */
#define fread(b,s,c,f) PerlIO_read(f,b,(s*c))
#define fwrite(b,s,c,f) PerlIO_write(f,b,(s*c))
#else
#define fread(b,s,c,f) _CANNOT fread
#define fwrite(b,s,c,f) _CANNOT fwrite
#endif
#define fseek(f,o,w) PerlIO_seek(f,o,w)
#define ftell(f) PerlIO_tell(f)
#define rewind(f) PerlIO_rewind(f)
#define clearerr(f) PerlIO_clearerr(f)
#define feof(f) PerlIO_eof(f)
#define ferror(f) PerlIO_error(f)
#define fdopen(fd,p) PerlIO_fdopen(fd,p)
#define fileno(f) PerlIO_fileno(f)
#define popen(c,m) my_popen(c,m)
#define pclose(f) my_pclose(f)
#define fsetpos(f,p) _CANNOT _fsetpos_
#define fgetpos(f,p) _CANNOT _fgetpos_
#define __filbuf(f) _CANNOT __filbuf_
#define _filbuf(f) _CANNOT _filbuf_
#define __flsbuf(c,f) _CANNOT __flsbuf_
#define _flsbuf(c,f) _CANNOT _flsbuf_
#define getw(f) _CANNOT _getw_
#define putw(v,f) _CANNOT _putw_
#if SFIO_VERSION < 20000101L
#define flockfile(f) _CANNOT _flockfile_
#define ftrylockfile(f) _CANNOT _ftrylockfile_
#define funlockfile(f) _CANNOT _funlockfile_
#endif
#define freopen(p,m,f) _CANNOT _freopen_
#define setbuf(f,b) _CANNOT _setbuf_
#define setvbuf(f,b,x,s) _CANNOT _setvbuf_
#define fscanf _CANNOT _fscanf_
#define fgets(s,n,f) _CANNOT _fgets_
--- NEW FILE: global.sym ---
# -*- buffer-read-only: t -*-
#
# global.sym
#
# Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by embed.pl from data in embed.fnc, embed.pl,
# pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
# Any changes made here will be lost!
#
# Edit those files and run 'make regen_headers' to effect changes.
#
perl_alloc_using
perl_alloc
perl_construct
perl_destruct
perl_free
perl_run
perl_parse
Perl_doing_taint
perl_clone
perl_clone_using
Perl_malloc
Perl_calloc
Perl_realloc
Perl_mfree
Perl_get_context
Perl_set_context
Perl_amagic_call
Perl_Gv_AMupdate
Perl_gv_handler
Perl_apply_attrs_string
Perl_avhv_delete_ent
Perl_avhv_exists_ent
Perl_avhv_fetch_ent
Perl_avhv_store_ent
Perl_avhv_iternext
Perl_avhv_iterval
Perl_avhv_keys
Perl_av_clear
Perl_av_delete
Perl_av_exists
Perl_av_extend
Perl_av_fetch
Perl_av_fill
Perl_av_len
Perl_av_make
Perl_av_pop
Perl_av_push
Perl_av_shift
Perl_av_store
Perl_av_undef
Perl_av_unshift
Perl_block_gimme
Perl_call_list
Perl_cast_ulong
Perl_cast_i32
Perl_cast_iv
Perl_cast_uv
Perl_my_chsize
Perl_condpair_magic
Perl_croak
Perl_vcroak
Perl_croak_nocontext
Perl_die_nocontext
Perl_deb_nocontext
Perl_form_nocontext
Perl_load_module_nocontext
Perl_mess_nocontext
Perl_warn_nocontext
Perl_warner_nocontext
Perl_newSVpvf_nocontext
Perl_sv_catpvf_nocontext
Perl_sv_setpvf_nocontext
Perl_sv_catpvf_mg_nocontext
Perl_sv_setpvf_mg_nocontext
Perl_fprintf_nocontext
Perl_printf_nocontext
Perl_cv_const_sv
Perl_cv_undef
Perl_cx_dump
Perl_filter_add
Perl_filter_del
Perl_filter_read
Perl_get_op_descs
Perl_get_op_names
Perl_get_ppaddr
Perl_deb
Perl_vdeb
Perl_debprofdump
Perl_debop
Perl_debstack
Perl_debstackptrs
Perl_delimcpy
Perl_die
Perl_dounwind
Perl_do_binmode
Perl_do_close
Perl_do_aspawn
Perl_do_spawn
Perl_do_spawn_nowait
Perl_do_join
Perl_do_open
Perl_do_open9
Perl_do_openn
Perl_do_sprintf
Perl_dowantarray
Perl_dump_all
Perl_dump_eval
Perl_dump_fds
Perl_dump_form
Perl_gv_dump
Perl_op_dump
Perl_pmop_dump
Perl_dump_packsubs
Perl_dump_sub
Perl_fbm_compile
Perl_fbm_instr
Perl_form
Perl_vform
Perl_free_tmps
Perl_gp_free
Perl_gp_ref
Perl_gv_AVadd
Perl_gv_HVadd
Perl_gv_IOadd
Perl_gv_autoload4
Perl_gv_check
Perl_gv_efullname
Perl_gv_efullname3
Perl_gv_efullname4
Perl_gv_fetchfile
Perl_gv_fetchmeth
Perl_gv_fetchmeth_autoload
Perl_gv_fetchmethod
Perl_gv_fetchmethod_autoload
Perl_gv_fetchpv
Perl_gv_fullname
Perl_gv_fullname3
Perl_gv_fullname4
Perl_gv_init
Perl_gv_stashpv
Perl_gv_stashpvn
Perl_gv_stashsv
Perl_hv_clear
Perl_hv_delayfree_ent
Perl_hv_delete
Perl_hv_delete_ent
Perl_hv_exists
Perl_hv_exists_ent
Perl_hv_fetch
Perl_hv_fetch_ent
Perl_hv_free_ent
Perl_hv_iterinit
Perl_hv_iterkey
Perl_hv_iterkeysv
Perl_hv_iternext
Perl_hv_iternextsv
Perl_hv_iternext_flags
Perl_hv_iterval
Perl_hv_ksplit
Perl_hv_magic
Perl_hv_store
Perl_hv_store_ent
Perl_hv_store_flags
Perl_hv_undef
Perl_ibcmp
Perl_ibcmp_locale
Perl_ibcmp_utf8
Perl_init_stacks
Perl_init_tm
Perl_instr
Perl_is_lvalue_sub
Perl_to_uni_upper_lc
Perl_to_uni_title_lc
Perl_to_uni_lower_lc
Perl_is_uni_alnum
Perl_is_uni_alnumc
Perl_is_uni_idfirst
Perl_is_uni_alpha
Perl_is_uni_ascii
Perl_is_uni_space
Perl_is_uni_cntrl
Perl_is_uni_graph
Perl_is_uni_digit
Perl_is_uni_upper
Perl_is_uni_lower
Perl_is_uni_print
Perl_is_uni_punct
Perl_is_uni_xdigit
Perl_to_uni_upper
Perl_to_uni_title
Perl_to_uni_lower
Perl_to_uni_fold
Perl_is_uni_alnum_lc
Perl_is_uni_alnumc_lc
Perl_is_uni_idfirst_lc
Perl_is_uni_alpha_lc
Perl_is_uni_ascii_lc
Perl_is_uni_space_lc
Perl_is_uni_cntrl_lc
Perl_is_uni_graph_lc
Perl_is_uni_digit_lc
Perl_is_uni_upper_lc
Perl_is_uni_lower_lc
Perl_is_uni_print_lc
Perl_is_uni_punct_lc
Perl_is_uni_xdigit_lc
Perl_is_utf8_char
Perl_is_utf8_string_loc
Perl_is_utf8_string
Perl_is_utf8_alnum
Perl_is_utf8_alnumc
Perl_is_utf8_idfirst
Perl_is_utf8_idcont
Perl_is_utf8_alpha
Perl_is_utf8_ascii
Perl_is_utf8_space
Perl_is_utf8_cntrl
Perl_is_utf8_digit
Perl_is_utf8_graph
Perl_is_utf8_upper
Perl_is_utf8_lower
Perl_is_utf8_print
Perl_is_utf8_punct
Perl_is_utf8_xdigit
Perl_is_utf8_mark
Perl_leave_scope
Perl_op_null
Perl_load_module
Perl_vload_module
Perl_looks_like_number
Perl_grok_bin
Perl_grok_hex
Perl_grok_number
Perl_grok_numeric_radix
Perl_grok_oct
Perl_markstack_grow
Perl_mess
Perl_vmess
Perl_sortsv
Perl_mg_clear
Perl_mg_copy
Perl_mg_find
Perl_mg_free
Perl_mg_get
Perl_mg_length
Perl_mg_magical
Perl_mg_set
Perl_mg_size
Perl_mini_mktime
Perl_moreswitches
Perl_my_atof
Perl_my_bcopy
Perl_my_bzero
Perl_my_exit
Perl_my_failure_exit
Perl_my_fflush_all
Perl_my_fork
Perl_atfork_lock
Perl_atfork_unlock
Perl_my_lstat
Perl_my_memcmp
Perl_my_memset
Perl_my_pclose
Perl_my_popen
Perl_my_popen_list
Perl_my_setenv
Perl_my_stat
Perl_my_strftime
Perl_my_swap
Perl_my_htonl
Perl_my_ntohl
Perl_newANONLIST
Perl_newANONHASH
Perl_newANONSUB
Perl_newASSIGNOP
Perl_newCONDOP
Perl_newCONSTSUB
Perl_newFORM
Perl_newFOROP
Perl_newLOGOP
Perl_newLOOPEX
Perl_newLOOPOP
Perl_newNULLLIST
Perl_newOP
Perl_newPROG
Perl_newRANGE
Perl_newSLICEOP
Perl_newSTATEOP
Perl_newSUB
Perl_newXS
Perl_newAV
Perl_newAVREF
Perl_newBINOP
Perl_newCVREF
Perl_newGVOP
Perl_newGVgen
Perl_newGVREF
Perl_newHVREF
Perl_newHV
Perl_newHVhv
Perl_newIO
Perl_newLISTOP
Perl_newPADOP
Perl_newPMOP
Perl_newPVOP
Perl_newRV
Perl_newRV_noinc
Perl_newSV
Perl_newSVREF
Perl_newSVOP
Perl_newSViv
Perl_newSVuv
Perl_newSVnv
Perl_newSVpv
Perl_newSVpvn
Perl_newSVpvn_share
Perl_newSVpvf
Perl_vnewSVpvf
Perl_newSVrv
Perl_newSVsv
Perl_newUNOP
Perl_newWHILEOP
Perl_new_stackinfo
Perl_scan_vstring
Perl_ninstr
Perl_op_free
Perl_pad_sv
Perl_new_struct_thread
Perl_reentrant_size
Perl_reentrant_init
Perl_reentrant_free
Perl_reentrant_retry
Perl_call_atexit
Perl_call_argv
Perl_call_method
Perl_call_pv
Perl_call_sv
Perl_despatch_signals
Perl_eval_pv
Perl_eval_sv
Perl_get_sv
Perl_get_av
Perl_get_hv
Perl_get_cv
Perl_init_i18nl10n
Perl_init_i18nl14n
Perl_new_collate
Perl_new_ctype
Perl_new_numeric
Perl_set_numeric_local
Perl_set_numeric_radix
Perl_set_numeric_standard
Perl_require_pv
Perl_pack_cat
Perl_packlist
Perl_pmflag
Perl_pop_scope
Perl_push_scope
Perl_regdump
Perl_regclass_swash
Perl_pregexec
Perl_pregfree
Perl_pregcomp
Perl_re_intuit_start
Perl_re_intuit_string
Perl_regexec_flags
Perl_regnext
Perl_repeatcpy
Perl_rninstr
Perl_rsignal
Perl_rsignal_state
Perl_savepv
Perl_savepvn
Perl_savesharedpv
Perl_savestack_grow
Perl_savestack_grow_cnt
Perl_save_aelem
Perl_save_alloc
Perl_save_aptr
Perl_save_ary
Perl_save_bool
Perl_save_clearsv
Perl_save_delete
Perl_save_destructor
Perl_save_destructor_x
Perl_save_freesv
Perl_save_freepv
Perl_save_generic_svref
Perl_save_generic_pvref
Perl_save_shared_pvref
Perl_save_gp
Perl_save_hash
Perl_save_helem
Perl_save_hints
Perl_save_hptr
Perl_save_I16
Perl_save_I32
Perl_save_I8
Perl_save_int
Perl_save_item
Perl_save_iv
Perl_save_list
Perl_save_long
Perl_save_mortalizesv
Perl_save_nogv
Perl_save_scalar
Perl_save_pptr
Perl_save_vptr
Perl_save_re_context
Perl_save_padsv
Perl_save_sptr
Perl_save_svref
Perl_save_threadsv
Perl_save_threadsv
Perl_scan_bin
Perl_scan_hex
Perl_scan_num
Perl_scan_oct
Perl_screaminstr
Perl_share_hek
Perl_csighandler
Perl_stack_grow
Perl_start_subparse
Perl_sv_2bool
Perl_sv_2cv
Perl_sv_2io
Perl_sv_2iv
Perl_sv_2mortal
Perl_sv_2nv
Perl_sv_2pv
Perl_sv_2pvutf8
Perl_sv_2pvbyte
Perl_sv_pvn_nomg
Perl_sv_2uv
Perl_sv_iv
Perl_sv_uv
Perl_sv_nv
Perl_sv_pvn
Perl_sv_pvutf8n
Perl_sv_pvbyten
Perl_sv_true
Perl_sv_backoff
Perl_sv_bless
Perl_sv_catpvf
Perl_sv_vcatpvf
Perl_sv_catpv
Perl_sv_catpvn
Perl_sv_catsv
Perl_sv_chop
Perl_sv_clear
Perl_sv_cmp
Perl_sv_cmp_locale
Perl_sv_collxfrm
Perl_sv_compile_2op
Perl_getcwd_sv
Perl_sv_dec
Perl_sv_dump
Perl_sv_derived_from
Perl_sv_eq
Perl_sv_free
Perl_sv_gets
Perl_sv_grow
Perl_sv_inc
Perl_sv_insert
Perl_sv_isa
Perl_sv_isobject
Perl_sv_len
Perl_sv_len_utf8
Perl_sv_magic
Perl_sv_magicext
Perl_sv_mortalcopy
Perl_sv_newmortal
Perl_sv_newref
Perl_sv_peek
Perl_sv_pos_u2b
Perl_sv_pos_b2u
Perl_sv_pvn_force
Perl_sv_pvutf8n_force
Perl_sv_pvbyten_force
Perl_sv_recode_to_utf8
Perl_sv_cat_decode
Perl_sv_reftype
Perl_sv_replace
Perl_sv_report_used
Perl_sv_reset
Perl_sv_setpvf
Perl_sv_vsetpvf
Perl_sv_setiv
Perl_sv_setpviv
Perl_sv_setuv
Perl_sv_setnv
Perl_sv_setref_iv
Perl_sv_setref_uv
Perl_sv_setref_nv
Perl_sv_setref_pv
Perl_sv_setref_pvn
Perl_sv_setpv
Perl_sv_setpvn
Perl_sv_setsv
Perl_sv_taint
Perl_sv_tainted
Perl_sv_unmagic
Perl_sv_unref
Perl_sv_unref_flags
Perl_sv_untaint
Perl_sv_upgrade
Perl_sv_usepvn
Perl_sv_vcatpvfn
Perl_sv_vsetpvfn
Perl_str_to_version
Perl_swash_init
Perl_swash_fetch
Perl_taint_env
Perl_taint_proper
Perl_to_utf8_case
Perl_to_utf8_lower
Perl_to_utf8_upper
Perl_to_utf8_title
Perl_to_utf8_fold
Perl_unlnk
Perl_unlock_condpair
Perl_unpack_str
Perl_unpackstring
Perl_unsharepvn
Perl_utf16_to_utf8
Perl_utf16_to_utf8_reversed
Perl_utf8_length
Perl_utf8_distance
Perl_utf8_hop
Perl_utf8_to_bytes
Perl_bytes_from_utf8
Perl_bytes_to_utf8
Perl_utf8_to_uvchr
Perl_utf8_to_uvuni
Perl_utf8n_to_uvchr
Perl_utf8n_to_uvuni
Perl_uvchr_to_utf8
Perl_uvuni_to_utf8
Perl_uvchr_to_utf8_flags
Perl_uvuni_to_utf8_flags
Perl_pv_uni_display
Perl_sv_uni_display
Perl_seed
Perl_warn
Perl_vwarn
Perl_warner
Perl_vwarner
Perl_whichsig
Perl_dump_mstats
Perl_get_mstats
Perl_safesysmalloc
Perl_safesyscalloc
Perl_safesysrealloc
Perl_safesysfree
Perl_GetVars
Perl_runops_standard
Perl_runops_debug
Perl_sv_lock
Perl_sv_catpvf_mg
Perl_sv_vcatpvf_mg
Perl_sv_catpv_mg
Perl_sv_catpvn_mg
Perl_sv_catsv_mg
Perl_sv_setpvf_mg
Perl_sv_vsetpvf_mg
Perl_sv_setiv_mg
Perl_sv_setpviv_mg
Perl_sv_setuv_mg
Perl_sv_setnv_mg
Perl_sv_setpv_mg
Perl_sv_setpvn_mg
Perl_sv_setsv_mg
Perl_sv_usepvn_mg
Perl_get_vtbl
Perl_pv_display
Perl_dump_indent
Perl_dump_vindent
Perl_do_gv_dump
Perl_do_gvgv_dump
Perl_do_hv_dump
Perl_do_magic_dump
Perl_do_op_dump
Perl_do_pmop_dump
Perl_do_sv_dump
Perl_magic_dump
Perl_default_protect
Perl_vdefault_protect
Perl_reginitcolors
Perl_sv_2pv_nolen
Perl_sv_2pvutf8_nolen
Perl_sv_2pvbyte_nolen
Perl_sv_pv
Perl_sv_pvutf8
Perl_sv_pvbyte
Perl_sv_utf8_upgrade
Perl_sv_utf8_downgrade
Perl_sv_utf8_encode
Perl_sv_utf8_decode
Perl_sv_force_normal
Perl_sv_force_normal_flags
Perl_tmps_grow
Perl_sv_rvweaken
Perl_newANONATTRSUB
Perl_newATTRSUB
Perl_newMYSUB
Perl_cx_dup
Perl_si_dup
Perl_ss_dup
Perl_any_dup
Perl_he_dup
Perl_re_dup
Perl_fp_dup
Perl_dirp_dup
Perl_gp_dup
Perl_mg_dup
Perl_sv_dup
Perl_rvpv_dup
Perl_sys_intern_dup
Perl_ptr_table_new
Perl_ptr_table_fetch
Perl_ptr_table_store
Perl_ptr_table_split
Perl_ptr_table_clear
Perl_ptr_table_free
Perl_sys_intern_clear
Perl_sys_intern_init
Perl_custom_op_name
Perl_custom_op_desc
Perl_sv_nosharing
Perl_sv_nolocking
Perl_sv_nounlocking
Perl_nothreadhook
Perl_Slab_Alloc
Perl_Slab_Free
Perl_sv_setsv_flags
Perl_sv_catpvn_flags
Perl_sv_catsv_flags
Perl_sv_utf8_upgrade_flags
Perl_sv_pvn_force_flags
Perl_sv_2pv_flags
Perl_sv_copypv
Perl_my_atof2
Perl_my_socketpair
Perl_PerlIO_close
Perl_PerlIO_fill
Perl_PerlIO_fileno
Perl_PerlIO_eof
Perl_PerlIO_error
Perl_PerlIO_flush
Perl_PerlIO_clearerr
Perl_PerlIO_set_cnt
Perl_PerlIO_set_ptrcnt
Perl_PerlIO_setlinebuf
Perl_PerlIO_read
Perl_PerlIO_write
Perl_PerlIO_unread
Perl_PerlIO_tell
Perl_PerlIO_seek
Perl_PerlIO_get_base
Perl_PerlIO_get_ptr
Perl_PerlIO_get_bufsiz
Perl_PerlIO_get_cnt
Perl_PerlIO_stdin
Perl_PerlIO_stdout
Perl_PerlIO_stderr
Perl_hv_clear_placeholders
Perl_hv_scalar
Perl_op_refcnt_lock
Perl_op_refcnt_unlock
Perl_savesvpv
Perl_ck_anoncode
Perl_ck_bitop
Perl_ck_concat
Perl_ck_defined
Perl_ck_delete
Perl_ck_die
Perl_ck_eof
Perl_ck_eval
Perl_ck_exec
Perl_ck_exists
Perl_ck_exit
Perl_ck_ftst
Perl_ck_fun
Perl_ck_glob
Perl_ck_grep
Perl_ck_index
Perl_ck_join
Perl_ck_lengthconst
Perl_ck_lfun
Perl_ck_listiob
Perl_ck_match
Perl_ck_method
Perl_ck_null
Perl_ck_open
Perl_ck_repeat
Perl_ck_require
Perl_ck_return
Perl_ck_rfun
Perl_ck_rvconst
Perl_ck_sassign
Perl_ck_select
Perl_ck_shift
Perl_ck_sort
Perl_ck_spair
Perl_ck_split
Perl_ck_subr
Perl_ck_substr
Perl_ck_svconst
Perl_ck_trunc
Perl_is_utf8_string_loclen
Perl_newSVhek
Perl_stashpv_hvname_match
Perl_gv_SVadd
Perl_ckwarn
Perl_ckwarn_d
# ex: set ro:
--- NEW FILE: locale.c ---
/* locale.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* A Elbereth Gilthoniel,
* silivren penna míriel
* o menel aglar elenath!
* Na-chaered palan-díriel
* o galadhremmin ennorath,
* Fanuilos, le linnathon
* nef aear, si nef aearon!
*/
/* utility functions for handling locale-specific stuff like what
* character represents the decimal point.
*/
#include "EXTERN.h"
#define PERL_IN_LOCALE_C
#include "perl.h"
#ifdef I_LOCALE
# include <locale.h>
#endif
#ifdef I_LANGINFO
# include <langinfo.h>
#endif
#include "reentr.h"
#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
* The standard return value of setlocale() is either
* (1) "xx_YY" if the first argument of setlocale() is not LC_ALL
* (2) "xa_YY xb_YY ..." if the first argument of setlocale() is LC_ALL
* (the space-separated values represent the various sublocales,
* in some unspecificed order)
*
* In some platforms it has a form like "LC_SOMETHING=Lang_Country.866\n",
* which is harmful for further use of the string in setlocale().
*
*/
STATIC char *
S_stdize_locale(pTHX_ char *locs)
{
const char *s = strchr(locs, '=');
bool okay = TRUE;
if (s) {
const char * const t = strchr(s, '.');
okay = FALSE;
if (t) {
const char * const u = strchr(t, '\n');
if (u && (u[1] == 0)) {
const STRLEN len = u - s;
Move(s + 1, locs, len, char);
locs[len] = 0;
okay = TRUE;
}
}
}
if (!okay)
Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
return locs;
}
#endif
void
Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
# ifdef HAS_LOCALECONV
struct lconv* lc;
lc = localeconv();
if (lc && lc->decimal_point) {
if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
SvREFCNT_dec(PL_numeric_radix_sv);
PL_numeric_radix_sv = Nullsv;
}
else {
if (PL_numeric_radix_sv)
sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
else
PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
}
}
else
PL_numeric_radix_sv = Nullsv;
# endif /* HAS_LOCALECONV */
#endif /* USE_LOCALE_NUMERIC */
}
/*
* Set up for a new numeric locale.
*/
void
Perl_new_numeric(pTHX_ char *newnum)
{
#ifdef USE_LOCALE_NUMERIC
if (! newnum) {
Safefree(PL_numeric_name);
PL_numeric_name = NULL;
PL_numeric_standard = TRUE;
PL_numeric_local = TRUE;
return;
}
if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
Safefree(PL_numeric_name);
PL_numeric_name = stdize_locale(savepv(newnum));
PL_numeric_standard = ((*newnum == 'C' && newnum[1] == '\0')
|| strEQ(newnum, "POSIX"));
PL_numeric_local = TRUE;
set_numeric_radix();
}
#endif /* USE_LOCALE_NUMERIC */
}
void
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
if (! PL_numeric_standard) {
setlocale(LC_NUMERIC, "C");
PL_numeric_standard = TRUE;
PL_numeric_local = FALSE;
set_numeric_radix();
}
#endif /* USE_LOCALE_NUMERIC */
}
void
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
if (! PL_numeric_local) {
setlocale(LC_NUMERIC, PL_numeric_name);
PL_numeric_standard = FALSE;
PL_numeric_local = TRUE;
set_numeric_radix();
}
#endif /* USE_LOCALE_NUMERIC */
}
/*
* Set up for a new ctype locale.
*/
void
Perl_new_ctype(pTHX_ char *newctype)
{
#ifdef USE_LOCALE_CTYPE
int i;
for (i = 0; i < 256; i++) {
if (isUPPER_LC(i))
PL_fold_locale[i] = toLOWER_LC(i);
else if (isLOWER_LC(i))
PL_fold_locale[i] = toUPPER_LC(i);
else
PL_fold_locale[i] = i;
}
#endif /* USE_LOCALE_CTYPE */
PERL_UNUSED_ARG(newctype);
}
/*
* Set up for a new collation locale.
*/
void
Perl_new_collate(pTHX_ char *newcoll)
{
#ifdef USE_LOCALE_COLLATE
if (! newcoll) {
if (PL_collation_name) {
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = NULL;
}
PL_collation_standard = TRUE;
PL_collxfrm_base = 0;
PL_collxfrm_mult = 2;
return;
}
if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = stdize_locale(savepv(newcoll));
PL_collation_standard = ((*newcoll == 'C' && newcoll[1] == '\0')
|| strEQ(newcoll, "POSIX"));
{
/* 2: at most so many chars ('a', 'b'). */
/* 50: surely no system expands a char more. */
#define XFRMBUFSIZE (2 * 50)
char xbuf[XFRMBUFSIZE];
const Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE);
const Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE);
const SSize_t mult = fb - fa;
if (mult < 1)
Perl_croak(aTHX_ "strxfrm() gets absurd");
PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0;
PL_collxfrm_mult = mult;
}
}
#endif /* USE_LOCALE_COLLATE */
}
/*
* Initialize locale awareness.
*/
int
Perl_init_i18nl10n(pTHX_ int printwarn)
{
int ok = 1;
/* returns
* 1 = set ok or not applicable,
* 0 = fallback to C locale,
* -1 = fallback to C locale failed
*/
#if defined(USE_LOCALE)
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
char *curcoll = NULL;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
#ifdef __GLIBC__
char *language = PerlEnv_getenv("LANGUAGE");
#endif
char *lc_all = PerlEnv_getenv("LC_ALL");
char *lang = PerlEnv_getenv("LANG");
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
/*
* Ultrix setlocale(..., "") fails if there are no environment
* variables from which to get a locale name.
*/
bool done = FALSE;
#ifdef LC_ALL
if (lang) {
if (setlocale(LC_ALL, ""))
done = TRUE;
else
setlocale_failure = TRUE;
}
if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
if (! (curctype =
setlocale(LC_CTYPE,
(!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
else
curctype = savepv(curctype);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! (curcoll =
setlocale(LC_COLLATE,
(!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
else
curcoll = savepv(curcoll);
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! (curnum =
setlocale(LC_NUMERIC,
(!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
else
curnum = savepv(curnum);
#endif /* USE_LOCALE_NUMERIC */
}
#endif /* LC_ALL */
#endif /* !LOCALE_ENVIRON_REQUIRED */
#ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
#endif /* LC_ALL */
if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
if (! (curctype = setlocale(LC_CTYPE, "")))
setlocale_failure = TRUE;
else
curctype = savepv(curctype);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! (curcoll = setlocale(LC_COLLATE, "")))
setlocale_failure = TRUE;
else
curcoll = savepv(curcoll);
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! (curnum = setlocale(LC_NUMERIC, "")))
setlocale_failure = TRUE;
else
curnum = savepv(curnum);
#endif /* USE_LOCALE_NUMERIC */
}
if (setlocale_failure) {
char *p;
bool locwarn = (printwarn > 1 ||
(printwarn &&
(!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
if (locwarn) {
#ifdef LC_ALL
PerlIO_printf(Perl_error_log,
"perl: warning: Setting locale failed.\n");
#else /* !LC_ALL */
PerlIO_printf(Perl_error_log,
"perl: warning: Setting locale failed for the categories:\n\t");
#ifdef USE_LOCALE_CTYPE
if (! curctype)
PerlIO_printf(Perl_error_log, "LC_CTYPE ");
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! curcoll)
PerlIO_printf(Perl_error_log, "LC_COLLATE ");
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! curnum)
PerlIO_printf(Perl_error_log, "LC_NUMERIC ");
#endif /* USE_LOCALE_NUMERIC */
PerlIO_printf(Perl_error_log, "\n");
#endif /* LC_ALL */
PerlIO_printf(Perl_error_log,
"perl: warning: Please check that your locale settings:\n");
#ifdef __GLIBC__
PerlIO_printf(Perl_error_log,
"\tLANGUAGE = %c%s%c,\n",
language ? '"' : '(',
language ? language : "unset",
language ? '"' : ')');
#endif
PerlIO_printf(Perl_error_log,
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
lc_all ? lc_all : "unset",
lc_all ? '"' : ')');
#if defined(USE_ENVIRON_ARRAY)
{
char **e;
for (e = environ; *e; e++) {
if (strnEQ(*e, "LC_", 3)
&& strnNE(*e, "LC_ALL=", 7)
&& (p = strchr(*e, '=')))
PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n",
(int)(p - *e), *e, p + 1);
}
}
#else
PerlIO_printf(Perl_error_log,
"\t(possibly more locale environment variables)\n");
#endif
PerlIO_printf(Perl_error_log,
"\tLANG = %c%s%c\n",
lang ? '"' : '(',
lang ? lang : "unset",
lang ? '"' : ')');
PerlIO_printf(Perl_error_log,
" are supported and installed on your system.\n");
}
#ifdef LC_ALL
if (setlocale(LC_ALL, "C")) {
if (locwarn)
PerlIO_printf(Perl_error_log,
"perl: warning: Falling back to the standard locale (\"C\").\n");
ok = 0;
}
else {
if (locwarn)
PerlIO_printf(Perl_error_log,
"perl: warning: Failed to fall back to the standard locale (\"C\").\n");
ok = -1;
}
#else /* ! LC_ALL */
if (0
#ifdef USE_LOCALE_CTYPE
|| !(curctype || setlocale(LC_CTYPE, "C"))
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
|| !(curcoll || setlocale(LC_COLLATE, "C"))
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
|| !(curnum || setlocale(LC_NUMERIC, "C"))
#endif /* USE_LOCALE_NUMERIC */
)
{
if (locwarn)
PerlIO_printf(Perl_error_log,
"perl: warning: Cannot fall back to the standard locale (\"C\").\n");
ok = -1;
}
#endif /* ! LC_ALL */
#ifdef USE_LOCALE_CTYPE
curctype = savepv(setlocale(LC_CTYPE, Nullch));
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
curcoll = savepv(setlocale(LC_COLLATE, Nullch));
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
curnum = savepv(setlocale(LC_NUMERIC, Nullch));
#endif /* USE_LOCALE_NUMERIC */
}
else {
#ifdef USE_LOCALE_CTYPE
new_ctype(curctype);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
new_collate(curcoll);
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
new_numeric(curnum);
#endif /* USE_LOCALE_NUMERIC */
}
#endif /* USE_LOCALE */
#ifdef USE_PERLIO
{
/* Set PL_utf8locale to TRUE if using PerlIO _and_
any of the following are true:
- nl_langinfo(CODESET) contains /^utf-?8/i
- $ENV{LC_ALL} contains /^utf-?8/i
- $ENV{LC_CTYPE} contains /^utf-?8/i
- $ENV{LANG} contains /^utf-?8/i
The LC_ALL, LC_CTYPE, LANG obey the usual override
hierarchy of locale environment variables. (LANGUAGE
affects only LC_MESSAGES only under glibc.) (If present,
it overrides LC_MESSAGES for GNU gettext, and it also
can have more than one locale, separated by spaces,
in case you need to know.)
If PL_utf8locale and PL_unicode (set by -C or by $ENV{PERL_UNICODE})
are true, perl.c:S_parse_body() will turn on the PerlIO :utf8 layer
on STDIN, STDOUT, STDERR, _and_ the default open discipline.
*/
bool utf8locale = FALSE;
char *codeset = NULL;
#if defined(HAS_NL_LANGINFO) && defined(CODESET)
codeset = nl_langinfo(CODESET);
#endif
if (codeset)
utf8locale = (ibcmp(codeset, "UTF-8", 5) == 0 ||
ibcmp(codeset, "UTF8", 4) == 0);
#if defined(USE_LOCALE)
else { /* nl_langinfo(CODESET) is supposed to correctly
* interpret the locale environment variables,
* but just in case it fails, let's do this manually. */
if (lang)
utf8locale = (ibcmp(lang, "UTF-8", 5) == 0 ||
ibcmp(lang, "UTF8", 4) == 0);
#ifdef USE_LOCALE_CTYPE
if (curctype)
utf8locale = (ibcmp(curctype, "UTF-8", 5) == 0 ||
ibcmp(curctype, "UTF8", 4) == 0);
#endif
if (lc_all)
utf8locale = (ibcmp(lc_all, "UTF-8", 5) == 0 ||
ibcmp(lc_all, "UTF8", 4) == 0);
}
#endif /* USE_LOCALE */
if (utf8locale)
PL_utf8locale = TRUE;
}
/* Set PL_unicode to $ENV{PERL_UNICODE} if using PerlIO.
This is an alternative to using the -C command line switch
(the -C if present will override this). */
{
char *p = PerlEnv_getenv("PERL_UNICODE");
PL_unicode = p ? parse_unicode_opts(&p) : 0;
}
#endif
#ifdef USE_LOCALE_CTYPE
Safefree(curctype);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
Safefree(curcoll);
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
Safefree(curnum);
#endif /* USE_LOCALE_NUMERIC */
return ok;
}
/* Backwards compatibility. */
int
Perl_init_i18nl14n(pTHX_ int printwarn)
{
return init_i18nl10n(printwarn);
}
#ifdef USE_LOCALE_COLLATE
/*
* mem_collxfrm() is a bit like strxfrm() but with two important
* differences. First, it handles embedded NULs. Second, it allocates
* a bit more memory than needed for the transformed data itself.
* The real transformed data begins at offset sizeof(collationix).
* Please see sv_collxfrm() to see how this is used.
*/
char *
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
{
char *xbuf;
STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
/* the first sizeof(collationix) bytes are used by sv_collxfrm(). */
/* the +1 is for the terminating NUL. */
xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1;
Newx(xbuf, xAlloc, char);
if (! xbuf)
goto bad;
*(U32*)xbuf = PL_collation_ix;
xout = sizeof(PL_collation_ix);
for (xin = 0; xin < len; ) {
SSize_t xused;
for (;;) {
xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout);
if (xused == -1)
goto bad;
if ((STRLEN)xused < xAlloc - xout)
break;
xAlloc = (2 * xAlloc) + 1;
Renew(xbuf, xAlloc, char);
if (! xbuf)
goto bad;
}
xin += strlen(s + xin) + 1;
xout += xused;
/* Embedded NULs are understood but silently skipped
* because they make no sense in locale collation. */
}
xbuf[xout] = '\0';
*xlen = xout - sizeof(PL_collation_ix);
return xbuf;
bad:
Safefree(xbuf);
*xlen = 0;
return NULL;
}
#endif /* USE_LOCALE_COLLATE */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: INSTALL ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
Install - Build and Installation guide for perl5.
=head1 Reporting Problems
Wherever possible please use the perlbug tool supplied with this Perl
to report problems, as it automatically includes summary configuration
information about your perl, which may help us track down problems far
more quickly. But first you should read the advice in this file,
carefully re-read the error message and check the relevant manual pages
on your system, as these may help you find an immediate solution. If
you are not sure whether what you are seeing is a bug, you can send a
message describing the problem to the comp.lang.perl.misc newsgroup to
get advice.
[...2614 lines suppressed...]
Note that you must have performed the installation already before running
the above, since the script collects the installed files to generate
the documentation.
=head1 AUTHOR
Original author: Andy Dougherty doughera at lafayette.edu , borrowing very
heavily from the original README by Larry Wall, with lots of helpful
feedback and additions from the perl5-porters at perl.org folks.
If you have problems, corrections, or questions, please see
L<"Reporting Problems"> above.
=head1 REDISTRIBUTION
This document is part of the Perl package and may be distributed under
the same terms as perl itself, with the following additional request:
If you are distributing a modified version of perl (perhaps as part of
a larger package) please B<do> modify these installation instructions
and the contact information to match your distribution.
--- NEW FILE: Makefile.micro ---
LD = $(CC)
DEFINES = -DPERL_CORE -DPERL_MICRO -DSTANDARD_C -DPERL_USE_SAFE_PUTENV
OPTIMIZE =
CFLAGS = $(DEFINES) $(OPTIMIZE)
LIBS = -lm
_O = .o
ENV = env
all: microperl
O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \
uglobals$(_O) ugv$(_O) uhv$(_O) \
umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \
upad$(_O) uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \
upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \
uregcomp$(_O) uregexec$(_O) urun$(_O) \
uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \
unumeric$(_O) ulocale$(_O) \
uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) uxsutils$(_O)
microperl: $(O)
$(LD) -o $@ $(O) $(LIBS)
H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \
hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h pad.h \
patchlevel.h perl.h perlsdio.h perlvars.h perly.h pp.h \
pp_proto.h proto.h reentr.h regexp.h scope.h sv.h thrdvar.h \
thread.h unixish.h utf8.h util.h warnings.h
HE = $(H) EXTERN.h
clean:
-rm -f $(O) microperl
distclean: clean
# The microconfiguration.
regen_uconfig:
$(ENV) CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH
# Do not regenerate perly.c and perly.h.
perly.c: perly.y
- at echo perly.c is uptodate
perly.h: perly.y
- at echo perly.h is uptodate
# The microperl objects.
uav$(_O): $(HE) av.c
$(CC) -c -o $@ $(CFLAGS) av.c
udeb$(_O): $(HE) deb.c
$(CC) -c -o $@ $(CFLAGS) deb.c
udoio$(_O): $(HE) doio.c
$(CC) -c -o $@ $(CFLAGS) doio.c
udoop$(_O): $(HE) doop.c
$(CC) -c -o $@ $(CFLAGS) doop.c
udump$(_O): $(HE) dump.c regcomp.h regnodes.h
$(CC) -c -o $@ $(CFLAGS) dump.c
uglobals$(_O): $(H) globals.c INTERN.h perlapi.h
$(CC) -c -o $@ $(CFLAGS) globals.c
ugv$(_O): $(HE) gv.c
$(CC) -c -o $@ $(CFLAGS) gv.c
uhv$(_O): $(HE) hv.c
$(CC) -c -o $@ $(CFLAGS) hv.c
umg$(_O): $(HE) mg.c
$(CC) -c -o $@ $(CFLAGS) mg.c
uperlmain$(_O): $(HE) miniperlmain.c
$(CC) -c -o $@ $(CFLAGS) miniperlmain.c
uop$(_O): $(HE) op.c keywords.h
$(CC) -c -o $@ $(CFLAGS) -DPERL_EXTERNAL_GLOB op.c
ureentr$(_O): $(HE) reentr.c
$(CC) -c -o $@ $(CFLAGS) reentr.c
upad$(_O): $(HE) pad.c
$(CC) -c -o $@ $(CFLAGS) pad.c
uperl$(_O): $(HE) perl.c
$(CC) -c -o $@ $(CFLAGS) perl.c
uperlio$(_O): $(HE) perlio.c
$(CC) -c -o $@ $(CFLAGS) perlio.c
uperly$(_O): $(HE) perly.c
$(CC) -c -o $@ $(CFLAGS) perly.c
upp$(_O): $(HE) pp.c
$(CC) -c -o $@ $(CFLAGS) pp.c
upp_ctl$(_O): $(HE) pp_ctl.c
$(CC) -c -o $@ $(CFLAGS) pp_ctl.c
upp_hot$(_O): $(HE) pp_hot.c
$(CC) -c -o $@ $(CFLAGS) pp_hot.c
upp_sys$(_O): $(HE) pp_sys.c
$(CC) -c -o $@ $(CFLAGS) pp_sys.c
upp_pack$(_O): $(HE) pp_pack.c
$(CC) -c -o $@ $(CFLAGS) pp_pack.c
upp_sort$(_O): $(HE) pp_sort.c
$(CC) -c -o $@ $(CFLAGS) pp_sort.c
uregcomp$(_O): $(HE) regcomp.c regcomp.h regnodes.h INTERN.h
$(CC) -c -o $@ $(CFLAGS) regcomp.c
uregexec$(_O): $(HE) regexec.c regcomp.h regnodes.h
$(CC) -c -o $@ $(CFLAGS) regexec.c
urun$(_O): $(HE) run.c
$(CC) -c -o $@ $(CFLAGS) run.c
uscope$(_O): $(HE) scope.c
$(CC) -c -o $@ $(CFLAGS) scope.c
usv$(_O): $(HE) sv.c
$(CC) -c -o $@ $(CFLAGS) sv.c
utaint$(_O): $(HE) taint.c
$(CC) -c -o $@ $(CFLAGS) taint.c
utoke$(_O): $(HE) toke.c keywords.h
$(CC) -c -o $@ $(CFLAGS) toke.c
ulocale$(_O): $(HE) locale.c
$(CC) -c -o $@ $(CFLAGS) locale.c
unumeric$(_O): $(HE) numeric.c
$(CC) -c -o $@ $(CFLAGS) numeric.c
uuniversal$(_O): $(HE) universal.c XSUB.h
$(CC) -c -o $@ $(CFLAGS) universal.c
uutf8$(_O): $(HE) utf8.c
$(CC) -c -o $@ $(CFLAGS) utf8.c
uutil$(_O): $(HE) util.c
$(CC) -c -o $@ $(CFLAGS) util.c
uperlapi$(_O): $(HE) perlapi.c perlapi.h
$(CC) -c -o $@ $(CFLAGS) perlapi.c
uxsutils$(_O): $(HE) xsutils.c
$(CC) -c -o $@ $(CFLAGS) xsutils.c
# That's it, folks!
--- NEW FILE: makeaperl.SH ---
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting makeaperl (with variable substitutions)"
rm -f makeaperl
$spitshell >makeaperl <<!GROK!THIS!
$startperl
eval 'exec $perlpath -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
!GROK!THIS!
$spitshell >>makeaperl <<'!NO!SUBS!'
=head1 NAME
makeaperl - create a new perl binary from static extensions
=head1 SYNOPSIS
C<makeaperl -l library -m makefile -o target -t tempdir [object_files] [static_extensions] [search_directories]>
=head1 DESCRIPTION
This utility is designed to build new perl binaries from existing
extensions on the fly. Called without any arguments it produces a new
binary with the name C<perl> in the current directory. Intermediate
files are produced in C</tmp>, if that is writeable, else in the
current directory. The most important intermediate file is a Makefile,
that is used internally to call C<make>. The new perl binary will consist
The C<-l> switch lets you specify the name of a perl library to be
linked into the new binary. If you do not specify a library, makeaperl
writes targets for any C<libperl*.a> it finds in the search path. The
topmost target will be the one related to C<libperl.a>.
With the C<-m> switch you can provide a name for the Makefile that
will be written (default C</tmp/Makefile.$$>). Likewise specifies the
C<-o> switch a name for the perl binary (default C<perl>). The C<-t>
switch lets you determine, in which directory the intermediate files
should be stored.
All object files and static extensions following on the command line
will be linked into the target file. If there are any directories
specified on the command line, these directories are searched for
C<*.a> files, and all of the found ones will be linked in, too. If
there is no directory named, then the contents of $INC[0] are
searched.
If the command fails, there is currently no other mechanism to adjust
the behaviour of the program than to alter the generated Makefile and
run C<make> by hand.
=head1 AUTHORS
Tim Bunce <Tim.Bunce at ig.co.uk>, Andreas Koenig
<koenig at franz.ww.TU-Berlin.DE>;
=head2 STATUS
First version, written 5 Feb 1995, is considered alpha.
=cut
use ExtUtils::MakeMaker;
use Getopt::Long;
use strict qw(subs refs);
$Version = 1.0;
$Verbose = 0;
sub usage{
warn <<END;
$0 version $Version
$0: [options] [object_files] [static_extensions ...] [directories to search through]
-l perllibrary perl library to link from (the first libperl.a found)
-m makefilename name of the makefile to be written (/tmp/Makefile.\$\$)
-o name name for perl executable (perl)
-t directory directory where intermediate files reside (/tmp)
END
exit 1;
}
if (-w "/tmp") {
$opt_t = "/tmp";
} else {
$opt_t = ".";
}
$opt_l = '';
$opt_m = "$opt_t/Makefile.$$";
$opt_o = 'perl';
$Getopt::Long::ignorecase=0;
GetOptions('t=s', 'l=s', 'm=s', 'o=s') || die &usage;
@dirs = grep -d $_, @ARGV;
@fils = grep -f $_, @ARGV;
@dirs = $INC[0] unless @dirs;
open MAKE, ">$opt_m";
MM->init_main();
MM->init_others();
print MAKE MM->makeaperl('MAKE' => $opt_m,
'TARGET' => $opt_o,
'TMP' => $opt_t,
'LIBPERL' => $opt_l,
'DIRS' => [@dirs],
'STAT' => [@fils],
'INCL' => [@dirs]
);
close MAKE;
(system "make -f $opt_m") == 0 or die "$0 failed: Please check file $opt_m and run make -f $opt_m\n";
!NO!SUBS!
chmod 755 makeaperl
$eunicefix makeaperl
--- NEW FILE: README.uts ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
perluts - Perl under UTS
=head1 SYNOPSIS
This document can be read I<as is>: as F<README.uts>, or you
can read it after you build your package using "man perluts".
The purpose is to help you build Perl for UTS, which, if you
follow these instructions, should be easy, and result in
a solidly working installation.
=head1 DESCRIPTION
Perl 5.7.2 (Developmental) or Perl 5.8.x (forthcoming) for UTS
=head1 BUILDING PERL ON UTS
NOTE: Some sites have redefined the way uname works, and if yours
does this, special steps must be taken so that Configure can
recognize your system as a UTS system. To see if you are in
this category, issue the command "uname -a". It should look
something like:
uts juno 4 4.4 9672 370
At any rate, the first field should be "uts". If this is not
the case; supposing it is, say telcoUTS, create a script, uts/uname
(i.e. uname, in the subdirectory "uts" of the main Perl source dir):
# uname
/usr/bin/uname "$@" | sed -e 's/^telcoUTS/uts/'
and when you execute Configure, do it as below, except for adding
PATH=uts:$PATH as a prefix. I.e. do:
PATH=uts:$PATH ./Configure ...
There is no need to do an interactive configure, just type
./Configure -de [-Dusedevel] [-Doptimize=-g ] 2>&1 | tee Conf.out
"-Dusedevel" may be required to configure Perl 5.7.2 non-interactively.
Use -Doptimize=-g if you want to run Perl under sdb or gdb, OR
if you want to be able to use the -D command line flags to perl,
which are occasionally useful in debugging perl scripts.
In this and the following steps, the "2>&1 | tee XXX.out" records all
output from the process, which will be useful if anything unexpected
goes wrong.
Then do the compilation with
make 2>&1 | tee make.out
Finally, test using
make test 2>&1 | tee make-test.out
In the output, the only failures you should see should look like:
lib/Math/BigInt/t/bigfltpm.........Use of uninitialized value ...
FAILED at test 57
lib/Math/BigInt/t/bigintc..........ok
lib/Math/BigInt/t/bigintpm.........FAILED at test 204
lib/Math/BigInt/t/mbimbf...........Use of uninitialized value ...
Illegal division by zero at ../lib/Math/BigInt/Calc.pm line 314.
FAILED at test 71
lib/Math/Complex...................exp: OVERFLOW
FAILED at test 250
lib/Math/Trig......................exp: OVERFLOW
ok
lib/Memoize/t/array................ok
...
lib/Net/protoent...................ok
lib/Net/servent....................FAILED at test 0
This means that everything passes except for some problems in the
packages "Math::BigInt", "Math::Complex", and "Math::Trig".
The lib/Net/servent failure seems to be a bug in the test
program. To confirm this, from the main Perl source dir, do:
LD_LIBRARY_PATH=`pwd` ./perl -Ilib lib/Net/servent.t
and it should output
1..3
ok 1
ok 2
ok 3
=head1 Installing the built perl on UTS
Run the command "make install"
=head1 AUTHOR
Hal Morris
UTS Global LLC
email: hom00 at utsglobal.com
=cut
--- NEW FILE: bytecode.pl ---
BEGIN {
push @INC, './lib';
require 'regen_lib.pl';
}
use strict;
my %alias_to = (
U32 => [qw(line_t)],
PADOFFSET => [qw(STRLEN SSize_t)],
U16 => [qw(OPCODE short)],
U8 => [qw(char)],
);
my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
# Nullsv *must* come first in the following so that the condition
# ($$sv == 0) can continue to be used to test (sv == Nullsv).
my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE);
my (%alias_from, $from, $tos);
while (($from, $tos) = each %alias_to) {
map { $alias_from{$_} = $from } @$tos;
}
my $c_header = <<'EOT';
/* -*- buffer-read-only: t -*-
*
* Copyright (c) 1996-1999 Malcolm Beattie
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* This file is autogenerated from bytecode.pl. Changes made here will be lost.
*/
EOT
my $perl_header;
($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
safer_unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm";
#
# Start with boilerplate for Asmdata.pm
#
open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!";
binmode ASMDATA_PM;
print ASMDATA_PM $perl_header, <<'EOT';
package B::Asmdata;
our $VERSION = '1.01';
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
our(%insn_data, @insn_name, @optype, @specialsv_name);
EOT
print ASMDATA_PM <<"EOT";
\@optype = qw(@optype);
\@specialsv_name = qw(@specialsv);
# XXX insn_data is initialised this way because with a large
# %insn_data = (foo => [...], bar => [...], ...) initialiser
# I get a hard-to-track-down stack underflow and segfault.
EOT
#
# Boilerplate for byterun.c
#
open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!";
binmode BYTERUN_C;
print BYTERUN_C $c_header, <<'EOT';
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#define NO_XSLOCKS
#include "XSUB.h"
#include "byterun.h"
#include "bytecode.h"
static const int optype_size[] = {
EOT
my $i = 0;
for ($i = 0; $i < @optype - 1; $i++) {
printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i;
}
printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i;
print BYTERUN_C <<'EOT';
};
void *
bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
{
if (ix > bstate->bs_obj_list_fill) {
Renew(bstate->bs_obj_list, ix + 32, void*);
bstate->bs_obj_list_fill = ix + 31;
}
bstate->bs_obj_list[ix] = obj;
return obj;
}
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
register int insn;
U32 ix;
SV *specialsv_list[6];
BYTECODE_HEADER_CHECK; /* croak if incorrect platform */
Newx(bstate->bs_obj_list, 32, void*); /* set op objlist */
bstate->bs_obj_list_fill = 31;
bstate->bs_obj_list[0] = NULL; /* first is always Null */
bstate->bs_ix = 1;
EOT
for my $i ( 0 .. $#specialsv ) {
print BYTERUN_C " specialsv_list[$i] = $specialsv[$i];\n";
}
print BYTERUN_C <<'EOT';
while ((insn = BGET_FGETC()) != EOF) {
switch (insn) {
EOT
my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
while (<DATA>) {
if (/^\s*#/) {
print BYTERUN_C if /^\s*#\s*(?:if|endif|el)/;
next;
}
chop;
next unless length;
if (/^%number\s+(.*)/) {
$insn_num = $1;
next;
} elsif (/%enum\s+(.*?)\s+(.*)/) {
create_enum($1, $2); # must come before instructions
next;
}
($insn, $lvalue, $argtype, $flags) = split;
my $rvalcast = '';
if ($argtype =~ m:(.+)/(.+):) {
($rvalcast, $argtype) = ("($1)", $2);
}
$insn_name[$insn_num] = $insn;
$fundtype = $alias_from{$argtype} || $argtype;
#
# Add the case statement and code for the bytecode interpreter in byterun.c
#
printf BYTERUN_C "\t case INSN_%s:\t\t/* %d */\n\t {\n",
uc($insn), $insn_num;
my $optarg = $argtype eq "none" ? "" : ", arg";
if ($optarg) {
printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
}
if ($flags =~ /x/) {
print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
} elsif ($flags =~ /s/) {
# Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
}
elsif ($optarg && $lvalue ne "none") {
print BYTERUN_C "\t\t$lvalue = ${rvalcast}arg;\n";
}
print BYTERUN_C "\t\tbreak;\n\t }\n";
#
# Add the initialiser line for %insn_data in Asmdata.pm
#
print ASMDATA_PM <<"EOT";
\$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"];
EOT
# Find the next unused instruction number
do { $insn_num++ } while $insn_name[$insn_num];
}
#
# Finish off byterun.c
#
print BYTERUN_C <<'EOT';
default:
Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
/* NOTREACHED */
}
}
return 0;
}
/* ex: set ro: */
EOT
#
# Write the instruction and optype enum constants into byterun.h
#
open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
binmode BYTERUN_H;
print BYTERUN_H $c_header, <<'EOT';
struct byteloader_fdata {
SV *datasv;
int next_out;
int idx;
};
struct byteloader_state {
struct byteloader_fdata *bs_fdata;
SV *bs_sv;
void **bs_obj_list;
int bs_obj_list_fill;
int bs_ix;
XPV bs_pv;
int bs_iv_overflows;
};
int bl_getc(struct byteloader_fdata *);
int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
extern int byterun(pTHX_ struct byteloader_state *);
enum {
EOT
my $add_enum_value = 0;
my $max_insn;
for $i ( 0 .. $#insn_name ) {
$insn = uc($insn_name[$i]);
if (defined($insn)) {
$max_insn = $i;
if ($add_enum_value) {
print BYTERUN_H " INSN_$insn = $i,\t\t\t/* $i */\n";
$add_enum_value = 0;
} else {
print BYTERUN_H " INSN_$insn,\t\t\t/* $i */\n";
}
} else {
$add_enum_value = 1;
}
}
print BYTERUN_H " MAX_INSN = $max_insn\n};\n";
print BYTERUN_H "\nenum {\n";
for ($i = 0; $i < @optype - 1; $i++) {
printf BYTERUN_H " OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
}
printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
print BYTERUN_H "/* ex: set ro: */\n";
#
# Finish off insn_data and create array initialisers in Asmdata.pm
#
print ASMDATA_PM <<'EOT';
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
$insn_name[$insn_data->[0]] = $insn_name;
}
# Fill in any gaps
@insn_name = map($_ || "unused", @insn_name);
1;
__END__
=head1 NAME
B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
=head1 SYNOPSIS
use B::Asmdata qw(%insn_data @insn_name @optype @specialsv_name);
=head1 DESCRIPTION
Provides information about Perl ops in order to generate bytecode via
a bunch of exported variables. Its mostly used by B::Assembler and
B::Disassembler.
=over 4
=item %insn_data
my($bytecode_num, $put_sub, $get_meth) = @$insn_data{$op_name};
For a given $op_name (for example, 'cop_label', 'sv_flags', etc...)
you get an array ref containing the bytecode number of the op, a
reference to the subroutine used to 'PUT', and the name of the method
used to 'GET'.
=for _private
Add more detail about what $put_sub and $get_meth are and how to use them.
=item @insn_name
my $op_name = $insn_name[$bytecode_num];
A simple mapping of the bytecode number to the name of the op.
Suitable for using with %insn_data like so:
my $op_info = $insn_data{$insn_name[$bytecode_num]};
=item @optype
my $op_type = $optype[$op_type_num];
A simple mapping of the op type number to its type (like 'COP' or 'BINOP').
=item @specialsv_name
my $sv_name = $specialsv_name[$sv_index];
Certain SV types are considered 'special'. They're represented by
B::SPECIAL and are referred to by a number from the specialsv_list.
This array maps that number back to the name of the SV (like 'Nullsv'
or '&PL_sv_undef').
=back
=head1 AUTHOR
Malcolm Beattie, C<mbeattie at sable.ox.ac.uk>
=cut
# ex: set ro:
EOT
close ASMDATA_PM or die "Error closing ASMDATA_PM: $!";
close BYTERUN_H or die "Error closing BYTERUN_H: $!";
close BYTERUN_C or die "Error closing BYTERUN_C: $!";
__END__
# First set instruction ord("#") to read comment to end-of-line (sneaky)
%number 35
comment arg comment_t
# Then make ord("\n") into a no-op
%number 10
nop none none
# Now for the rest of the ordinary ones, beginning with \0 which is
# ret so that \0-terminated strings can be read properly as bytecode.
%number 0
#
# The argtype is either a single type or "rightvaluecast/argtype".
#
#opcode lvalue argtype flags
#
ret none none x
ldsv bstate->bs_sv svindex
ldop PL_op opindex
stsv bstate->bs_sv U32 s
stop PL_op U32 s
stpv bstate->bs_pv.xpv_pv U32 x
ldspecsv bstate->bs_sv U8 x
ldspecsvx bstate->bs_sv U8 x
newsv bstate->bs_sv U8 x
newsvx bstate->bs_sv U32 x
newop PL_op U8 x
newopx PL_op U16 x
newopn PL_op U8 x
newpv none PV
pv_cur bstate->bs_pv.xpv_cur STRLEN
pv_free bstate->bs_pv none x
sv_upgrade bstate->bs_sv U8 x
sv_refcnt SvREFCNT(bstate->bs_sv) U32
sv_refcnt_add SvREFCNT(bstate->bs_sv) I32 x
sv_flags SvFLAGS(bstate->bs_sv) U32
xrv bstate->bs_sv svindex x
xpv bstate->bs_sv none x
xpv_cur bstate->bs_sv STRLEN x
xpv_len bstate->bs_sv STRLEN x
xiv bstate->bs_sv IV x
xnv bstate->bs_sv NV x
xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN
xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN
xlv_targ LvTARG(bstate->bs_sv) svindex
xlv_type LvTYPE(bstate->bs_sv) char
xbm_useful BmUSEFUL(bstate->bs_sv) I32
xbm_previous BmPREVIOUS(bstate->bs_sv) U16
xbm_rare BmRARE(bstate->bs_sv) U8
xfm_lines FmLINES(bstate->bs_sv) IV
xio_lines IoLINES(bstate->bs_sv) IV
xio_page IoPAGE(bstate->bs_sv) IV
xio_page_len IoPAGE_LEN(bstate->bs_sv) IV
xio_lines_left IoLINES_LEFT(bstate->bs_sv) IV
xio_top_name IoTOP_NAME(bstate->bs_sv) pvindex
xio_top_gv *(SV**)&IoTOP_GV(bstate->bs_sv) svindex
xio_fmt_name IoFMT_NAME(bstate->bs_sv) pvindex
xio_fmt_gv *(SV**)&IoFMT_GV(bstate->bs_sv) svindex
xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv) pvindex
xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->bs_sv) svindex
xio_subprocess IoSUBPROCESS(bstate->bs_sv) short
xio_type IoTYPE(bstate->bs_sv) char
xio_flags IoFLAGS(bstate->bs_sv) char
xcv_xsubany *(SV**)&CvXSUBANY(bstate->bs_sv).any_ptr svindex
xcv_stash *(SV**)&CvSTASH(bstate->bs_sv) svindex
xcv_start CvSTART(bstate->bs_sv) opindex
xcv_root CvROOT(bstate->bs_sv) opindex
xcv_gv *(SV**)&CvGV(bstate->bs_sv) svindex
xcv_file CvFILE(bstate->bs_sv) pvindex
xcv_depth CvDEPTH(bstate->bs_sv) long
xcv_padlist *(SV**)&CvPADLIST(bstate->bs_sv) svindex
xcv_outside *(SV**)&CvOUTSIDE(bstate->bs_sv) svindex
xcv_outside_seq CvOUTSIDE_SEQ(bstate->bs_sv) U32
xcv_flags CvFLAGS(bstate->bs_sv) U16
av_extend bstate->bs_sv SSize_t x
av_pushx bstate->bs_sv svindex x
av_push bstate->bs_sv svindex x
xav_fill AvFILLp(bstate->bs_sv) SSize_t
xav_max AvMAX(bstate->bs_sv) SSize_t
xav_flags AvFLAGS(bstate->bs_sv) U8
xhv_riter HvRITER(bstate->bs_sv) I32
xhv_name bstate->bs_sv pvindex x
xhv_pmroot *(OP**)&HvPMROOT(bstate->bs_sv) opindex
hv_store bstate->bs_sv svindex x
sv_magic bstate->bs_sv char x
mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex
mg_private SvMAGIC(bstate->bs_sv)->mg_private U16
mg_flags SvMAGIC(bstate->bs_sv)->mg_flags U8
mg_name SvMAGIC(bstate->bs_sv) pvcontents x
mg_namex SvMAGIC(bstate->bs_sv) svindex x
xmg_stash bstate->bs_sv svindex x
gv_fetchpv bstate->bs_sv strconst x
gv_fetchpvx bstate->bs_sv strconst x
gv_stashpv bstate->bs_sv strconst x
gv_stashpvx bstate->bs_sv strconst x
gp_sv GvSV(bstate->bs_sv) svindex
gp_refcnt GvREFCNT(bstate->bs_sv) U32
gp_refcnt_add GvREFCNT(bstate->bs_sv) I32 x
gp_av *(SV**)&GvAV(bstate->bs_sv) svindex
gp_hv *(SV**)&GvHV(bstate->bs_sv) svindex
gp_cv *(SV**)&GvCV(bstate->bs_sv) svindex
gp_file GvFILE(bstate->bs_sv) pvindex
gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex
gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex
gp_cvgen GvCVGEN(bstate->bs_sv) U32
gp_line GvLINE(bstate->bs_sv) line_t
gp_share bstate->bs_sv svindex x
xgv_flags GvFLAGS(bstate->bs_sv) U8
op_next PL_op->op_next opindex
op_sibling PL_op->op_sibling opindex
op_ppaddr PL_op->op_ppaddr strconst x
op_targ PL_op->op_targ PADOFFSET
op_type PL_op OPCODE x
op_seq PL_op->op_seq U16
op_flags PL_op->op_flags U8
op_private PL_op->op_private U8
op_first cUNOP->op_first opindex
op_last cBINOP->op_last opindex
op_other cLOGOP->op_other opindex
op_pmreplroot cPMOP->op_pmreplroot opindex
op_pmreplstart cPMOP->op_pmreplstart opindex
op_pmnext *(OP**)&cPMOP->op_pmnext opindex
#ifdef USE_ITHREADS
op_pmstashpv cPMOP pvindex x
op_pmreplrootpo cPMOP->op_pmreplroot OP*/PADOFFSET
#else
op_pmstash *(SV**)&cPMOP->op_pmstash svindex
op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex
#endif
pregcomp PL_op pvcontents x
op_pmflags cPMOP->op_pmflags U16
op_pmpermflags cPMOP->op_pmpermflags U16
op_pmdynflags cPMOP->op_pmdynflags U8
op_sv cSVOP->op_sv svindex
op_padix cPADOP->op_padix PADOFFSET
op_pv cPVOP->op_pv pvcontents
op_pv_tr cPVOP->op_pv op_tr_array
op_redoop cLOOP->op_redoop opindex
op_nextop cLOOP->op_nextop opindex
op_lastop cLOOP->op_lastop opindex
cop_label cCOP->cop_label pvindex
#ifdef USE_ITHREADS
cop_stashpv cCOP pvindex x
cop_file cCOP pvindex x
#else
cop_stash cCOP svindex x
cop_filegv cCOP svindex x
#endif
cop_seq cCOP->cop_seq U32
cop_arybase cCOP->cop_arybase I32
cop_line cCOP->cop_line line_t
cop_io cCOP->cop_io svindex
cop_warnings cCOP->cop_warnings svindex
main_start PL_main_start opindex
main_root PL_main_root opindex
main_cv *(SV**)&PL_main_cv svindex
curpad PL_curpad svindex x
push_begin PL_beginav svindex x
push_init PL_initav svindex x
push_end PL_endav svindex x
curstash *(SV**)&PL_curstash svindex
defstash *(SV**)&PL_defstash svindex
data none U8 x
incav *(SV**)&GvAV(PL_incgv) svindex
load_glob none svindex x
#ifdef USE_ITHREADS
regex_padav *(SV**)&PL_regex_padav svindex
#endif
dowarn PL_dowarn U8
comppad_name *(SV**)&PL_comppad_name svindex
xgv_stash *(SV**)&GvSTASH(bstate->bs_sv) svindex
signal bstate->bs_sv strconst x
# to be removed
formfeed PL_formfeed svindex
--- NEW FILE: AUTHORS ---
# To give due honour to those who have made Perl 5 what it is today,
# here are easily-from-changelogs-extractable people and their
# (hopefully) current and preferred email addresses (as of 2002, if known)
# from the Changes files. These people have either submitted
# patches or suggestions, or their bug reports or comments have inspired
# the appropriate patches. Corrections, additions, deletions welcome;
# send them to perl5-porters at perl.org, preferably as the output of diff(1),
# diff -u or diff -c between the original and a corrected version of this file.
#
# The use of this database for anything else than Perl development
# is strictly forbidden. (Passive distribution with the Perl source
# code kit is, of course, allowed.)
--
A. C. Yardley <yardley at tanet.net>
Aaron B. Dossett <aaron at iglou.com>
Aaron J. Mackey <ajm6q at virginia.edu>
Abe Timmerman <abe at ztreet.demon.nl>
Abhijit Menon-Sen <ams at wiw.org>
Abigail <abigail at abigail.nl>
Achim Bohnet <ach at mpe.mpg.de>
Adam Kennedy <adam at ali.as>
Adam Krolnik <adamk at gypsy.cyrix.com>
Adam Milner <carmiac at nmt.edu>
Adam Spiers
Adrian M. Enache <enache at rdslink.ro>
Akim Demaille <akim at epita.fr>
Alan Burlison <Alan.Burlison at uk.sun.com>
Alan Champion <achampio at lehman.com>
Alan Harder <Alan.Harder at Ebay.Sun.COM>
Alan Modra
Alan Ferrency <alan at pair.com>
Albert Chin-A-Young <china at thewrittenword.com>
Albert Dvornik <bert at genscan.com>
Alessandro Forghieri <alf at orion.it>
Alexei Alexandrov <alexei.alexandrov at gmail.com>
Alex Gough <alex at rcon.rog>
Alex Vandiver <alexmv at mit.edu>
Alexander Gough <alex-p5p at earth.li>
Alexander Klimov <ask at wisdom.weizmann.ac.il>
Alexander Smishlajev <als at turnhere.com>
Alexey Mahotkin <alexm at netli.com>
Alexey Tourbin <at at altlinux.ru>
Alexey V. Barantsev <barancev at kazbek.ispras.ru>
Allen Smith <allens at cpan.org>
Alain Barbet <alian at cpan.org>
Ambrose Kofi Laing
Ananth Kesari <HYanantha at novell.com>
Anders Johnson <ajohnson at nvidia.com>
Andreas Klussmann <andreas at infosys.heitec.de>
Andreas König <a.koenig at mind.de>
Andreas Schwab <schwab at suse.de>
Andrej Borsenkow <Andrej.Borsenkow at mow.siemens.ru>
Andrew Bettison <andrewb at zip.com.au>
Andrew Cohen <cohen at andy.bu.edu>
andrew deryabin <djsf at technarchy.ru>
Andrew Hamm <AHamm at civica.com.au>
Andrew M. Langmead <aml at world.std.com>
Andrew Pimlott <pimlott at idiomtech.com>
Andrew Vignaux <ajv at nz.sangacorp.com>
Andrew Wilcox <awilcox at maine.com>
Andrey Sapozhnikov <sapa at icb.chel.su>
Andy Bussey <andybussey at yahoo.co.uk>
Andy Dougherty <doughera at lafayette.edu>
Andy Lester <andy at petdance.com>
Anno Siegel <anno4000 at lublin.zrz.tu-berlin.de>
Anthony David <adavid at netinfo.com.au>
Anton Berezin <tobez at tobez.org>
Anton Tagunov <tagunov at motor.ru>
Archer Sully <archer at meer.net>
Arjen Laarhoven <arjen at nl.demon.net>
Arne Ahrend <aahrend at web.de>
Art Green <Art_Green at mercmarine.com>
Art Haas <ahaas at airmail.net>
Artiom Morozov <artiom at phreaker.net>
Artur Bergman <artur at contiller.se>
Audrey Tang <autrijus at autrijus.org>
Axel Boldt
Barrie Slaymaker <barries at slaysys.com>
Barry Friedman
Beau Cox
Ben Tilly <ben_tilly at operamail.com>
Benjamin Goldberg <goldbb2 at earthlink.net>
Benjamin Holzman <bah at ecnvantage.com>
Benjamin Low <b.d.low at unsw.edu.au>
Benjamin Stuhl <sho_pi at hotmail.com>
Benjamin Sugars <bsugars at canoe.ca>
Bernard Quatermass <bernard at quatermass.co.uk>
Bill Campbell <bill at celestial.com>
Bill Glicker <billg at burrelles.com>
Billy Constantine <wdconsta at cs.adelaide.edu.au>
Blair Zajac <blair at orcaware.com>
Bob Dalgleish <Robert.Dalgleish at sk.sympatico.ca>
Bob Wilkinson
Boris Zentner <bzm at 2bz.de>
Boyd Gerber <gerberb at zenez.com>
Brad Appleton <bradapp at enteract.com>
Brad Howerter <bhower at wgc.woodward.com>
Brad Hughes <brad at tgsmc.com>
Brad Lanam <bll at gentoo.com>
Bram <perl-rt at wizbit.be>
Brendan O'Dea <bod at debian.org>
Brent B. Powers <powers at ml.com>
Brent Dax <brentdax at cpan.org>
Brooks D Boyd
Brian Callaghan <callagh at itginc.com>
Brian Clarke <clarke at appliedmeta.com>
Brian Grossman
Brian Harrison <brie at corp.home.net>
Brian Ingerson <ingy at ttul.org>
Brian Jepson <bjepson at oreilly.com>
Brian Katzung
Brian McCauley <nobull at mail.com>
Brian Reichert <reichert at internet.com>
Brian S. Cashman <bsc at umich.edu>
Bruce Barnett <barnett at grymoire.crd.ge.com>
Bruce J. Keeler <bkeelerx at iwa.dp.intel.com>
Bruce P. Schuck <bruce at aps.org>
Bud Huff <BAHUFF at us.oracle.com>
Byron Brummer <byron at omix.com>
C Aditya <caditya at novell.com>
Calle Dybedahl <calle at lysator.liu.se>
Campo Weijerman <rfc822 at nl.ibm.com>
Carl Eklof <CEklof at endeca.com>
Carl M. Fongheiser <cmf at ins.infonet.net>
Carl Witty <cwitty at newtonlabs.com>
Cary D. Renzema <caryr at mxim.com>
Casey West <casey at geeknest.com>
Castor Fu
Chaim Frenkel <chaimf at pobox.com>
Charles Bailey <bailey at newman.upenn.edu>
Charles F. Randall <crandall at free.click-n-call.com>
Charles Lane <lane at DUPHY4.Physics.Drexel.Edu>
Charles Randall <cfriv at yahoo.com>
Charles Wilson <cwilson at ece.gatech.edu>
Chaskiel M Grundman
Chia-liang Kao <clkao at clkao.org>
Chip Salzenberg <chip at pobox.com>
Chip Turner <cturner at redhat.com>
chocolateboy <chocolateboy at chocolatey.com>
Chris Ball <chris at cpan.org>
Chris Bongaarts <cab at tc.umn.edu>
Chris Faylor <cgf at bbc.com>
Chris Heath <chris at heathens.co.nz>
Chris Nandor <pudge at pobox.com>
Chris Pepper
Chris Wick <cwick at lmc.com>
Christian Kirsch <ck at held.mind.de>
Christopher Chan-Nui <channui at austin.ibm.com>
Christopher Davis <ckd at loiosh.kei.com>
chromatic <chromatic at wgz.org>
Chuck D. Phillips <cdp at hpescdp.fc.hp.com>
Chuck Phillips <cdp at fc.hp.com>
Chunhui Teng <cteng at nortel.ca>
Clark Cooper <coopercc at netheaven.com>
Claes Jacobsson <claes at surfar.nu>
Clinton A. Pierce <clintp at geeksalad.org>
Colin Kuskie <ckuskie at cadence.com>
Colin McMillen <mcmi0073 at tc.umn.edu>
Colin Meyer <cmeyer at helvella.org>
Colin Watson <colinw at zeus.com>
Conrad Augustin
Conrad E. Kimball <cek at tblv021.ca.boeing.com>
Craig A. Berry <craigberry at mac.com>
Craig Milo Rogers <Rogers at ISI.EDU>
Curtis Poe <cp at onsitetech.com>
Dale Amon <amon at vnl.com>
Damian Conway <damian at cs.monash.edu.au>
Damon Atkins <Damon.Atkins at nabaus.com.au>
Dan Boorstein <dan_boo at bellsouth.net>
Dan Brook <dbrook at easyspace.com>
Dan Hale <danhale at us.ibm.com>
Dan Jacobson
Dan Kogai <dankogai at dan.co.jp>
Dan Schmidt <dfan at harmonixmusic.com>
Dan Sugalski <dan at sidhe.org>
Daniel Berger <djberg86 at attbi.com>
Daniel Chetlin <daniel at chetlin.com>
Daniel Grisinger <dgris at dimensional.com>
Daniel Lieberman <daniel at bitpusher.com>
Daniel Muiño <dmuino at afip.gov.ar>
Daniel P. Berrange <dan at berrange.com>
Daniel S. Lewart <lewart at uiuc.edu>
Daniel Yacob <perl at geez.org>
Danny R. Faught <faught at mailhost.rsn.hp.com>
Danny Sadinoff <sadinoff at olf.com>
Darrell Kindred <dkindred+ at cmu.edu>
Darrell Schiebel <drs at nrao.edu>
Darren/Torin/Who Ever... <torin at daft.com>
Dave Bianchi
Dave Hartnoll <Dave_Hartnoll at 3b2.com>
Dave Liney <dave.liney at gbr.conoco.com>
Dave Nelson <David.Nelson at bellcow.com>
Dave Paris
Dave Rolsky <autarch at urth.org>
Dave Schweisguth <dcs at neutron.chem.yale.edu>
David Billinghurst <David.Billinghurst at riotinto.com.au>
David Campbell
David Cantrell <david at cantrell.org.uk>
David Couture
David D. Kilzer <ddkilzer at lubricants-oil.com>
David Denholm <denholm at conmat.phys.soton.ac.uk>
David Dyck <dcd at tc.fluke.com>
David Cannings <lists at edeca.net>
David F. Haertig <dfh at dwroll.lucent.com>
David Favor <david at davidfavor.com>
David Filo
David Glasser <me at davidglasser.net>
David H. Adler <dha at panix.com>
David Hammen <hammen at gothamcity.jsc.nasa.gov>
David J. Fiander <davidf at mks.com>
David Kerry <davidk at tor.securecomputing.com>
David Mitchell <davem at iabyn.nospamdeletethisbit.com>
David Muir Sharnoff <muir at idiom.com>
david nicol <whatever at davidnicol.com>
David R. Favor <dfavor at austin.ibm.com>
David Sparks <daves at ActiveState.com>
David Starks-Browning <dstarks at rc.tudelft.nl>
David Sundstrom <sunds at asictest.sc.ti.com>
Davin Milun <milun at cs.Buffalo.EDU>
Dean Roehrich <roehrich at cray.com>
deekoo <deekoo at tentacle.net>
Dennis Marsa <dennism at cyrix.com>
DH <crazyinsomniac at yahoo.com>
Diab Jerius <dj at head-cfa.harvard.edu>
dLux <dlux at spam.sch.bme.hu>
Dominic Dunlop <domo at computer.org>
Dominique Dumont <Dominique_Dumont at grenoble.hp.com>
Dominique Quatravaux
Doug Campbell <soup at ampersand.com>
Doug MacEachern <dougm at covalent.net>
Douglas E. Wegscheid <dwegscheid at qtm.net>
Douglas Lankshear <dougl at activestate.com>
Douglas Wilson <dougw at cpan.org>
Dov Grobgeld <dov at Orbotech.Co.IL>
Drago Goricanec <drago at raptor.otsd.ts.fujitsu.co.jp>
Duncan Findlay <duncf at debian.org>
Ed Mooring <mooring at Lynx.COM>
Ed Peschko <epeschko at den-mdev1>
Edmund Bacon
Edward Avis <ed at membled.com>
Edward Moy <emoy at apple.com>
Edward Peschko <edwardp at excitehome.net>
Elaine -HFB- Ashton <elaine at chaos.wustl.edu>
Elizabeth Mattijsen <liz at dijkmat.nl>
Enrico Sorcinelli <bepi at perl.it>
Eric Arnold <eric.arnold at sun.com>
Eric Amick
Eric Bartley <bartley at icd.cc.purdue.edu>
Eric E. Coe <Eric.Coe at oracle.com>
Eric Fifer <egf7 at columbia.edu>
Eric Melville
Eric Promislow <ericp at ActiveState.com>
Erich Rickheit
Eryq <eryq at zeegee.com>
Etienne Grossman <etienne at isr.isr.ist.utl.pt>
Eugene Alterman <Eugene.Alterman at bremer-inc.com>
Fabien Tassin <tassin at eerie.fr>
Felix Gallo <fgallo at etoys.com>
Fergal Daly <fergal at esatclear.ie>
Florent Guillaume
Frank Crawford
Frank Ridderbusch <Frank.Ridderbusch at pdb.siemens.de>
Frank Tobin <ftobin at uiuc.edu>
François Désarménien <desar at club-internet.fr>
Fréderic Chauveau <fmc at pasteur.fr>
G. Del Merritt <del at intranetics.com>
Gabe Schaffer
Garry T. Williams <garry at zvolve.com>
Gary Clark <GaryC at mail.jeld-wen.com>
Gary L. Armstrong
Gary Ng <71564.1743 at compuserve.com>
Geoffrey F. Green <geoff-public at stuebegreen.com>
Georg Schwarz <geos at epost.de>
George Necula <necula at eecs.berkeley.edu>
Geraint A Edwards <gedge at serf.org>
Gerben Wierda <G.C.Th.Wierda at AWT.nl>
Gerd Knops <gerti at BITart.com>
Gerrit P. Haase <gp at familiehaase.de>
Giles Lean <giles at nemeton.com.au>
Gisle Aas <gisle at aas.no>
Gordon J. Miller <gjm at cray.com>
Grace Lee <grace at hal.com>
Graham Barr <gbarr at pobox.com>
Graham TerMarsch <graham at howlingfrog.com>
Greg Bacon <gbacon at itsc.uah.edu>
Greg Chapman <glc at well.com>
Greg Earle
Greg Kuperberg
Greg Matheson <lang at ms.chinmin.edu.tw>
Greg Seibert <seibert at Lynx.COM>
Greg Ward <gward at ase.com>
Gregor Chrupala <gregor.chrupala at star-group.net>
Gregory Martin Pfeil <pfeilgm at technomadic.org>
Guenter Schmidt <gsc at bruker.de>
Guido Flohr <guido at imperia.net>
Guruprasad S <SGURUPRASAD at novell.com>
Gurusamy Sarathy <gsar at activestate.com>
Gustaf Neumann
Guy Decoux <decoux at moulon.inra.fr>
Gwyn Judd <b.judd at xtra.co.nz>
H.J. Lu <hjl at nynexst.com>
H.Merijn Brand <h.m.brand at xs4all.nl>
Hal Morris <hom00 at utsglobal.com>
Hal Pomeranz <pomeranz at netcom.com>
Hallvard B Furuseth <h.b.furuseth at usit.uio.no>
Hannu Napari <Hannu.Napari at hut.fi>
Hans de Graaff <J.J.deGraaff at twi.tudelft.nl>
Hans Ginzel <hans at kolej.mff.cuni.cz>
Hans Mulder <hansmu at xs4all.nl>
Hans Ranke <Hans.Ranke at ei.tum.de>
Harmon S. Nine <hnine at netarx.com>
Harri Pasanen <harri.pasanen at trema.com>
Harry Edmon <harry at atmos.washington.edu>
Helmut Jarausch <jarausch at numa1.igpm.rwth-aachen.de>
Henrik Tougaard <ht.000 at foa.dk>
Hernan Perez Masci <hmasci at uolsinectis.com.ar>
Hershel Walters <walters at smd4d.wes.army.mil>
Holger Bechtold
Hrunting Jonhson
Horst von Brand <vonbrand at sleipnir.valparaiso.cl>
Hubert Feyrer <hubert.feyrer at informatik.fh-regensburg.de>
Hugo van der Sanden <hv at crypt.org>
Hunter Kelly <retnuh at zule.pixar.com>
Huw Rogers <count0 at gremlin.straylight.co.jp>
Iain Truskett
Ian Maloney <ian.malonet at ubs.com>
Ian Phillipps <Ian.Phillipps at iname.com>
Ignasi Roca Carrió <ignasi.roca at fujitsu-siemens.com>
Ilmari Karonen <iltzu at sci.fi>
Ilya Martynov <ilya at martynov.org>
Ilya N. Golubev <gin at mo.msk.ru>
Ilya Sandler <Ilya.Sandler at etak.com>
Ilya Zakharevich <ilya at math.berkeley.edu>
Inaba Hiroto <inaba at st.rim.or.jp>
Indy Singh <indy at nusphere.com>
Ingo Weinhold
insecure <insecure at mail.od.ua>
Irving Reid <irving at tor.securecomputing.com>
Ivan Kurmanov <kurmanov at openlib.org>
Ivan Tubert-Brohman <itub at cpan.org>
J. David Blackstone <jdb at dfwnet.sbms.sbc.com>
J. van Krieken <John.van.Krieken at ATComputing.nl>
Jack Shirazi <JackS at GemStone.com>
Jacqui Caren <Jacqui.Caren at ig.co.uk>
Jake Hamby <jehamby at lightside.com>
James <james at rf.net>
James A. Duncan <jduncan at fotango.com>
James FitzGibbon <james at ican.net>
James Jurach <muaddib at erf.net>
James Mastros <james at mastros.biz>
Jamshid Afshar
Jan D. <jan.djarv at mbox200.swipnet.se>
Jan Dubois <jand at activestate.com>
Jan Pazdziora <adelton at fi.muni.cz>
Jan-Erik Karlsson <trg at privat.utfors.se>
Jan-Pieter Cornet <johnpc at xs4all.nl>
Jared Rhine <jared at organic.com>
Jari Aalto <jari.aalto at poboxes.com>
Jarkko Hietaniemi <jhi at iki.fi>
Jason A. Smith <smithj4 at rpi.edu>
Jason E. Stewart <jason at openinformatics.com>
Jason Shirk
Jason Stewart <jasons at cs.unm.edu>
Jason Varsoke <jjv at caesun10.msd.ray.com>
Jay Hannah <jhannah at omnihotels.com>
Jay Rogers <jay at rgrs.com>
JD Laub <jdl at access-health.com>
Jeff Bouis
Jeff McDougal <jmcdo at cris.com>
Jeff Okamoto <okamoto at corp.hp.com>
Jeff Pinyan <japhy at pobox.com>
Jeff Urlwin <jurlwin at access.digex.net>
Jeffrey Friedl <jfriedl at regex.info>
Jeffrey S. Haemer <jsh at woodcock.boulder.qms.com>
Jens Hamisch <jens at Strawberry.COM>
Jens T. Berger Thielemann <jensthi at ifi.uio.no>
Jens Thomsen <jens at fiend.cis.com>
Jens-Uwe Mager <jum at helios.de>
Jeremy D. Zawodny <jzawodn at wcnet.org>
Jeremy H. Brown <jhbrown at ai.mit.edu>
Jeremy Madea <jmadea at inktomi.com>
Jerome Abela <abela at hsc.fr>
Jerrad Pierce <belg4mit at MIT.EDU>
Jesús Quiroga <jquiroga at pobox.com>
Jim Anderson <jander at ml.com>
Jim Avera <avera at hal.com>
Jim Balter
Jim Cromie <jcromie at cpan.org>
Jim Meyering <meyering at asic.sc.ti.com>
Jim Miner <jfm at winternet.com>
Jim Richardson
Jim Schneider <jschneid at netilla.com>
Joachim Huober
Jochen Wiedmann <joe at ispsoft.de>
Joe Buehler <jbuehler at hekimian.com>
Joe McMahon <mcmahon at ibiblio.org>
Joe Orton <jorton at redhat.com>
Joe Schaefer <joe+perl at sunstarsys.com>
Joe Smith <jsmith at inwap.com>
Joel Rosi-Schwartz <j.schwartz at agonet.it>
Joerg Porath <Joerg.Porath at informatik.tu-chemnitz.de>
Joergen Haegg
Johan Holtman
Johan Vromans <jvromans at squirrel.nl>
Johann Klasek <jk at auto.tuwien.ac.at>
John Bley <jbb6 at acpub.duke.edu>
John Borwick <jhborwic at unity.ncsu.edu>
John Cerney <j-cerney1 at ti.com>
John D Groenveld <groenvel at cse.psu.edu>
John Goodyear <johngood at us.ibm.com>
John Hasstedt <John.Hasstedt at sunysb.edu>
John Holdsworth <coldwave at bigfoot.com>
John Hughes <john at AtlanTech.COM>
John Kristian <jmk2001 at engineer.com>
John L. Allen <allen at grumman.com>
John Macdonald <jmm at revenge.elegant.com>
John Nolan <jpnolan at Op.Net>
John P. Linderman <jpl at research.att.com>
John Peacock <jpeacock at rowman.com>
John Pfuntner <pfuntner at vnet.ibm.com>
John Poltorak <jp at eyup.org>
John Rowe
John Salinas <jsalinas at cray.com>
John Stoffel <jfs at fluent.com>
John Stumbles <jstumbles at bluearc.com>
John Tobey <jtobey at john-edwin-tobey.org>
Johnny Lam <jlam at jgrind.org>
Jon Eveland <jweveland at yahoo.com>
Jon Gunnip <jongunnip at hotmail.com>
Jon Orwant <orwant at oreilly.com>
Jonathan Biggar <jon at sems.com>
Jonathan D Johnston <jdjohnston2 at juno.com>
Jonathan Fine <jfine at borders.com>
Jonathan I. Kamens <jik at kamens.brookline.ma.us>
Jonathan Roy <roy at idle.com>
Jonathan Stowe <gellyfish at gellyfish.com>
Jos I. Boumans <kane at dwim.org>
Jose Auguste-Etienne <Jose.auguste-etienne at cgss-guyane.fr>
Joseph N. Hall <joseph at cscaper.com>
Joseph S. Myers <jsm28 at hermes.cam.ac.uk>
Joshua E. Rodd <jrodd at pbs.org>
Joshua Pritikin <joshua.pritikin at db.com>
Joost van Baal <J.E.vanBaal at uvt.nl>
JT McDuffie <jt at kpc.com>
Juan Gallego <Little.Boss at physics.mcgill.ca>
Juerd Waalboer <juerd at cpan.org>
Juha Laiho <juha.laiho at Elma.Net>
Julian Yip <julian at imoney.com>
Jungshik Shin <jshin at mailaps.org>
Justin Banks <justinb at cray.com>
John E. Malmberg <wb8tyw at qsl.net>
Jörg Walter <jwalt at cpan.org>
José Pedro Oliveira <jpo at di.uminho.pt>
Ka-Ping Yee <kpyee at aw.sgi.com>
Karl Glazebrook <kgb at aaossz.aao.GOV.AU>
Karl Heuer <kwzh at gnu.org>
Karl Simon Berg <karl at it.kth.se>
Karsten Sperling <spiff at phreax.net>
Kaveh Ghazi <ghazi at caip.rutgers.edu>
Kay Röpke <kroepke at dolphin-services.de>
KAWAI Takanori <GCD00051 at nifty.ne.jp>
Keith Neufeld <neufeld at fast.pvi.org>
Keith Thompson <kst at cts.com>
Keith Thompson <kst at SDSC.EDU>
Ken Estes <estes at ms.com>
Ken Fox <kfox at ford.com>
Ken Hirsch <kenhirsch at ftml.net>
Ken MacLeod <ken at bitsko.slc.ut.us>
Ken Neighbors
Ken Shan <ken at digitas.harvard.edu>
Ken Williams <ken at mathforum.org>
Kenneth Albanowski <kjahds at kjahds.com>
Kenneth Duda <kjd at cisco.com>
Keong Lim <Keong.Lim at sr.com.au>
Kevin Chase <kevincha99 at hotmail.com>
Kevin O'Gorman <kevin.kosman at nrc.com>
Kevin Ruscoe <Kevin.Ruscoe at ubsw.com>
Kevin White <klwhite at magnus.acs.ohio-state.edu>
Kim Frutiger
Kingpin <mthurn at copper.dulles.tasc.com>
Kirrily Robert <skud at infotrope.net>
Kragen Sitaker <kragen at pobox.com>
Krishna Sethuraman <krishna at sgi.com>
Kurt D. Starsinic <kstar at wolfetech.com>
Kyriakos Georgiou
Larry Parmelee <parmelee at CS.Cornell.EDU>
Larry Schuler
Larry Schwimmer <rosebud at cyclone.Stanford.EDU>
Larry Shatzer <fugazi at zyx.net>
Larry W. Virden <lvirden at cas.org>
Larry Wall <larry at wall.org>
Lars Hecking <lhecking at nmrc.ucc.ie>
Laszlo Molnar <laszlo.molnar at eth.ericsson.se>
Leif Huhn <leif at hale.dkstat.com>
Len Johnson <lenjay at ibm.net>
Leon Brocard <acme at astray.com>
Les Peters <lpeters at aol.net>
Lincoln D. Stein <lstein at cshl.org>
Lionel Cons <lionel.cons at cern.ch>
Luc St-Louis <luc.st-louis at ca.transport.bombardier.com>
Luca Fini
Lukas Mai
Luke Closs <lukec at ActiveState.com>
Lupe Christoph <lupe at lupe-christoph.de>
Luther Huffman <lutherh at stratcom.com>
Major Sébastien <sebastien.major at crdp.ac-caen.fr>
Makoto MATSUSHITA <matusita at ics.es.osaka-u.ac.jp>
Malcolm Beattie <mbeattie at sable.ox.ac.uk>
Manuel Valente <mvalente at idealx.com>
Marc Lehmann <pcg at goof.com>
Marc Paquette <Marc.Paquette at Softimage.COM>
Marcel Grunauer <marcel at codewerk.com>
Marek Rouchal <marek.rouchal at infineon.com>
Mark A Biggar <mab at wdl.loral.com>
Marcus Holland-Moritz <mhx-perl at gmx.net>
Mark A. Hershberger <mah at everybody.org>
Mark Bixby <mark at bixby.org>
Mark Dickinson <dickins3 at fas.harvard.edu>
Mark Fisher <fisherm at tce.com>
Mark Fowler <mark at twoshortplanks.com>
Mark Hanson
Mark J. Reed <mreed at strange.turner.com>
Mark K Trettin <mkt at lucent.com>
Mark Kaehny <kaehny at execpc.com>
Mark Kettenis <kettenis at wins.uva.nl>
Mark Klein <mklein at dis.com>
Mark Knutsen <knutsen at pilot.njin.net>
Mark Kvale <kvale at phy.ucsf.edu>
Mark Leighton Fisher <mark-fisher at mindspring.com>
Mark Mielke <mark at mark.mielke.cc>
Mark Murray <mark at grondar.za>
Mark P. Lutz <mark.p.lutz at boeing.com>
Mark Pease <peasem at primenet.com>
Mark Pizzolato <mark at infocomm.com>
Mark R. Levinson <mrl at isc.upenn.edu>
Mark-Jason Dominus <mjd at plover.com>
Martien Verbruggen <mgjv at comdyn.com.au>
Martijn Koster <mak at excitecorp.com>
Martin Husemann <martin at duskware.de>
Martin J. Bligh <mbligh at us.ibm.com>
Martin Jost <Martin.Jost at icn.siemens.de>
Martin Lichtin <lichtin at bivio.com>
Martin Plechsmid <plechsmi at karlin.mff.cuni.cz>
Martin Pool <mbp at samba.org>
Martti Rahkila <martti.rahkila at hut.fi>
Marty Lucich <marty at netcom.com>
Marty Pauley <marty+p5p at kasei.com>
Martyn Pearce <martyn at inpharmatica.co.uk>
Masahiro KAJIURA <masahiro.kajiura at toshiba.co.jp>
Mathias Koerber <mathias at dnssec1.singnet.com.sg>
Mathieu Arnold <m at absolight.fr>
Mats Peterson <mats at sm6sxl.net>
Matt Kimball
Matt Sergeant <matt at sergeant.org>
Matthew Black <black at csulb.edu>
Matthew Green <mrg at splode.eterna.com.au>
Matthew Sachs <matthewg at zevils.com>
Matthew T Harden <mthard at mthard1.monsanto.com>
Matthias Ulrich Neeracher <neeracher at mac.com>
Matthias Urlichs <smurf at noris.net>
Mattia Barbon <mbarbon at dsi.unive.it>
Maurizio Loreti <maurizio.loreti at pd.infn.it>
Max Baker <max at warped.org>
Max Maischein <corion at corion.net>
Merijn Broeren <merijnb at iloquent.nl>
Michael A Chase <mchase at ix.netcom.com>
Michael Carman <mjcarman at home.com>
Michael Cook <mcook at cognex.com>
Michael De La Rue <mikedlr at tardis.ed.ac.uk>
Michael Engel <engel at nms1.cc.huji.ac.il>
Michael G Schwern <schwern at pobox.com>
Michael H. Moran <mhm at austin.ibm.com>
Michael King <mike808 at users.sourceforge.net>
Michael Mahan <mahanm at nextwork.rose-hulman.edu>
Michael Schroeder <Michael.Schroeder at informatik.uni-erlangen.de>
Michael Somos <somos at grail.cba.csuohio.edu>
Michael Stevens <mstevens at globnix.org>
Michele Sardo
Mik Firestone <fireston at lexmark.com>
Mike Fletcher <fletch at phydeaux.org>
Mike Giroux <rmgiroux at acm.org>
Mike Guy <mjtg at cam.ac.uk>
Mike Hopkirk <hops at sco.com>
Mike Mestnik <MMestnik at rustconsulting.com>
Mike Pomraning <mjp at pilcrow.madison.wi.us>
Mike Rogers
Mike Schilli <m at perlmeister.com>
Mike Stok <mike at stok.co.uk>
Mike W Ellwood <mwe at rl.ac.uk>
Mikhail Zabaluev <mhz at alt-linux.org>
Milton L. Hankins <mlh at swl.msd.ray.com>
Mr. Nobody <mrnobo1024 at yahoo.com>
Murray Nesbitt <murray at nesbitt.ca>
Nathan Kurz <nate at valleytel.net>
Nathan Torkington <gnat at frii.com>
Neale Ferguson <neale at VMA.TABNSW.COM.AU>
Neil Bowers <neil at bowers.com>
Neil Watkiss <neil.watkiss at sophos.com>
Nicholas Clark <nick at ccl4.org>
Nicholas Oxhøj
Nick Duffek
Nick Gianniotis
Nick Ing-Simmons <nick at ing-simmons.net>
Nick Williams <Nick.Williams at morganstanley.com>
Nigel Sandever <njsandever at hotmail.com>
Nikola Knezevic <indy at tesla.rcub.bg.ac.yu>
Nikola Milutinovic
Nikolai Eipel <eipel at web.de>
Noah <sitz at onastick.net>
Norbert Pueschel <pueschel at imsdd.meb.uni-bonn.de>
Norton T. Allen <allen at huarp.harvard.edu>
Offer Kaye <offer.kaye at gmail.com>
OKAIE Yutaka
Olaf Flebbe <o.flebbe at science-computing.de>
Olaf Titz <olaf at bigred.inka.de>
Olli Savia
Ollivier Robert <roberto at keltia.freenix.fr>
Olivier Thauvin <olivier.thauvin at aerov.jussieu.fr>
Owen Taylor <owt1 at cornell.edu>
parv <parv at pair.com>
Pascal Rigaux <pixel at mandriva.com>
Patrick Hayes <Patrick.Hayes.CAP_SESA at renault.fr>
Patrick O'Brien <pdo at cs.umd.edu>
Paul A Sand <pas at unh.edu>
Paul David Fardy <pdf at morgan.ucs.mun.ca>
Paul Eggert <eggert at twinsun.com>
Paul Fenwick <pjf at perltraining.com.au>
Paul Green <Paul.Green at stratus.com>
Paul Hoffman <phoffman at proper.com>
Paul Holser <Paul.Holser.pholser at nortelnetworks.com>
Paul Johnson <paul at pjcj.net>
Paul Lindner <lindner at inuus.com>
Paul Marquess <paul.marquess at btinternet.com>
Paul Moore <Paul.Moore at uk.origin-it.com>
Paul Rogers <Paul.Rogers at Central.Sun.COM>
Paul Saab <ps at yahoo-inc.com>
Paul Schinder <schinder at pobox.com>
Paul Szabo <psz at maths.usyd.edu.au>
Per Einar Ellefsen <per.einar at skynet.be>
Peter BARABAS
Pete Peterson <petersonp at genrad.com>
Peter Chines <pchines at nhgri.nih.gov>
Peter Dintelmann <Peter.Dintelmann at Dresdner-Bank.com>
Peter Gessner <peter.gessner at post.rwth-aachen.de>
Peter Gordon <peter at valor.com>
Peter Haworth <pmh at edison.ioppublishing.com>
Peter J. Farley III <pjfarley at banet.net>
Peter Jaspers-Fayer
Peter O'Gorman <peter at pogma.com>
Peter Prymmer <PPrymmer at factset.com>
Peter Scott <Peter at PSDT.com>
Peter van Heusden <pvh at junior.uwc.ac.za>
Peter Wolfe <wolfe at teloseng.com>
Petter Reinholdtsen <pere at hungry.com>
Phil Lobbes <phil at perkpartners.com>
Philip Hazel <ph10 at cus.cam.ac.uk>
Philip Newton <pne at cpan.org>
Philippe M. Chiasson <gozer at ActiveState.com>
Piers Cawley <pdcawley at bofh.org.uk>
Piotr Fusik <pfusik at op.pl>
Piotr Klaban <makler at oryl.man.torun.pl>
Pradeep Hodigere <phodigere at yahoo.com>
Prymmer/Kahn <pvhp at best.com>
Quentin Fennessy <quentin at arrakeen.amd.com>
Radu Greab <radu at netsoft.ro>
Rafael Garcia-Suarez <rgarciasuarez at mandriva.com>
Rainer Keuchel <keuchel at allgeier.com>
Rainer Orth <ro at TechFak.Uni-Bielefeld.DE>
Rajesh Vaidheeswarran <rv at gnu.org>
Ralf S. Engelschall <rse at engelschall.com>
Randal L. Schwartz <merlyn at stonehenge.com>
Randall Gellens <randy at qualcomm.com>
Randolf Werner <randolf.werner at sap.com>
Randy J. Ray <rjray at redhat.com>
Randy W. Sims
Raphael Manfredi <Raphael.Manfredi at pobox.com>
Raul Dias <raul at dias.com.br>
Raymund Will <ray at caldera.de>
Redvers Davies <red at criticalintegration.com>
Reini Urban <rurban at sbox.tu-graz.ac.at>
Rex Dieter <rdieter at math.unl.edu>
Rich Morin <rdm at cfcl.com>
Rich Salz <rsalz at bbn.com>
Richard A. Wells <Rwells at uhs.harvard.edu>
Richard Clamp <richardc at unixbeard.net>
Richard Foley <richard.foley at ubsw.com>
Richard Hatch <rhatch at austin.ibm.com>
Richard Hitt <rbh00 at utsglobal.com>
Richard Kandarian <richard.kandarian at lanl.gov>
Richard L. England <richard_england at mentorg.com>
Richard L. Maus, Jr. <rmaus at monmouth.com>
Richard Soderberg <p5-authors at crystalflame.net>
Richard Yeh <rcyeh at cco.caltech.edu>
Rick Delaney <rick at consumercontact.com>
Rick Pluta
Rickard Westman
Rob Brown <bbb at cpan.org>
Rob Henderson <robh at cs.indiana.edu>
Rob Napier <rnapier at employees.org>
Robert Millan <rmh at debian.org>
Robert Partington <rjp at riffraff.plig.net>
Robert Sanders <Robert.Sanders at linux.org>
Robert Spier <rspier at pobox.com>
Robin Barker <RMBarker at cpan.org>
Robin Houston <robin at kitsite.com>
Rocco Caputo <troc at netrus.net>
Roderick Schertler <roderick at argon.org>
Rodger Anderson <rodger at boi.hp.com>
Ronald F. Guilmette <rfg at monkeys.com>
Ronald J. Kimball <rjk at linguist.dartmouth.edu>
Ruben Schattevoy <schattev at imb-jena.de>
Rujith S. de Silva <desilva at netbox.com>
Russ Allbery <rra at stanford.edu>
Russell Fulton <russell at ccu1.auckland.ac.nz>
Russell Mosemann
Ryan Herbert <rherbert at sycamorehq.com>
SADAHIRO Tomoyuki <BQW10602 at nifty.com>
SAKAI Kiyotaka <ksakai at netwk.ntt-at.co.jp>
Salvador Fandiño <sfandino at yahoo.com>
Sam Tregar <sam at tregar.com>
Sam Vilain <sam at vilain.net>
Samuli Kärkkäinen <skarkkai at woods.iki.fi>
Schuyler Erle <schuyler at oreilly.com>
Scott A Crosby <scrosby at cs.rice.edu>
Scott Bronson <bronson at rinspin.com>
Scott Gifford <sgifford at tir.com>
Scott Henry <scotth at sgi.com>
Scott L. Miller <Scott.L.Miller at Compaq.com>
Sean Dague <sean at dague.net>
Sean Davis <dive at ender.com>
Sean M. Burke <sburke at cpan.org>
Sean Robinson <robinson_s at sc.maricopa.edu>
Sean Sheedy <seans at ncube.com>
Sebastian Wittmeier <Sebastian.Wittmeier at ginko.de>
Sébastien Aperghis-Tramoni <sebastien at aperghis.net>
Sebastien Barre <Sebastien.Barre at utc.fr>
Shigeya Suzuki <shigeya at foretune.co.jp>
Shimpei Yamashita <shimpei at socrates.patnet.caltech.edu>
Shinya Hayakawa <hayakawa at livedoor.jp>
Shishir Gundavaram <shishir at ruby.ora.com>
Shlomi Fish <shlomif at vipe.technion.ac.il>
Simon Cozens <simon at netthink.co.uk>
Simon Glover <scog at roe.ac.uk>
Simon Leinen
Simon Parsons <S.Parsons at ftel.co.uk>
Sisyphus <sisyphus1 at optusnet.com.au>
Slaven Rezic <slaven at rezic.de>
Solar Designer <solar at openwall.com>
Spider Boardman <spider at orb.nashua.nh.us>
Stas Bekman <stas at stason.org>
Steffen Müller <7k8lrvf02 at sneakemail.com>
Steffen Ullrich <coyote.frank at gmx.net>
Stéphane Payrard <stef at mongueurs.net>
Stephanie Beals <bealzy at us.ibm.com>
Stephen Clouse <stephenc at theiqgroup.com>
Stephen McCamant <smcc at mit.edu>
Stephen O. Lidie <lusol at turkey.cc.Lehigh.EDU>
Stephen P. Potter <spp at ds.net>
Stephen Zander <gibreel at pobox.com>
Steve A Fink <sfink at cs.berkeley.edu>
Steve Grazzini <grazz at pobox.com>
Steve Hay <Steve.Hay at uk.radan.com>
Steve Kelem <steve.kelem at xilinx.com>
Steve McDougall <swmcd at world.std.com>
Steve Nielsen <spn at enteract.com>
Steve Pearlmutter
Steve Peters <steve at fisharerojo.org>
Steve Vinoski
Steven Hirsch <hirschs at btv.ibm.com>
Steven Knight <knight at theopera.baldmt.citilink.com>
Steven Morlock <newspost at morlock.net>
Steven N. Hirsch <hirschs at stargate.btv.ibm.com>
Steven Parkes <parkes at sierravista.com>
Steven Schubiger <schubiger at cpan.org>
Stian Seeberg <sseeberg at nimsoft.no>
Sven Verdoolaege <skimo at breughel.ufsia.ac.be>
SynaptiCAD, Inc. <sales at syncad.com>
Takis Psarogiannakopoulos <takis at xfree86.org>
Taro KAWAGISHI
Tassilo von Parseval <tassilo.parseval at post.rwth-aachen.de>
Tatsuhiko Miyagawa <miyagawa at edge.co.jp>
Ted Ashton <ashted at southern.edu>
Ted Law <tedlaw at cibcwg.com>
Tels <nospam-abuse at bloodgate.com>
Teun Burgers <burgers at ecn.nl>
Thad Floryan <thad at thadlabs.com>
Thomas Bowditch <bowditch at inmet.com>
Thomas Conté <tom at fr.uu.net>
Thomas Dorner <Thomas.Dorner at start.de>
Thomas Kofler
Thomas König
Thomas Wegner <wegner_thomas at yahoo.com>
Thorsten Glaser
Tim Adye <T.J.Adye at rl.ac.uk>
Tim Ayers <tayers at bridge.com>
Tim Bunce <Tim.Bunce at pobox.com>
Tim Conrow <tim at spindrift.srl.caltech.edu>
Tim Freeman <tfreeman at infoseek.com>
Tim Jenness <t.jenness at jach.hawaii.edu>
Tim Mooney <mooney at dogbert.cc.ndsu.NoDak.edu>
Tim Sweetman <tim at aldigital.co.uk>
Tim Witham <twitham at pcocd2.intel.com>
Timur I. Bakeyev <bsdi at listserv.bat.ru>
Tkil <tkil at reptile.scrye.com>
Todd C. Miller <Todd.Miller at courtesan.com>
Todd T. Fries <todd at fries.int.mrleng.com>
Todd Vierling <tv at duh.org>
Tom Bates <tom_bates at att.net>
Tom Brown <thecap at peach.ece.utexas.edu>
Tom Dinger
Tom Christiansen <tchrist at perl.com>
Tom Horsley <Tom.Horsley at mail.ccur.com>
Tom Hughes <tom at compton.nu>
Tom Phoenix <rootbeer at teleport.com>
Tom Spindler <dogcow at isi.net>
Ton Hospel
Tony Bowden <tony at kasei.com>
Tony Camas
Tony Cook <tony at develop-help.com>
Tony Sanders <sanders at bsdi.com>
Tor Lillqvist <tml at hemuli.tte.vtt.fi>
Torsten Foertsch <torsten.foertsch at gmx.net>
Trevor Blackwell <tlb at viaweb.com>
Tuomas J. Lukka <tjl at lukka.student.harvard.edu>
Tsutomu IKEGAMI <t-ikegami at aist.go.jp>
Tye McQueen <tye at metronet.com>
Ulrich Kunitz <kunitz at mai-koeln.com>
Ulrich Pfeifer <pfeifer at wait.de>
Vadim Konovalov <vkonovalov at spb.lucent.com>
Valeriy E. Ushakov <uwe at ptc.spbu.ru>
Ville Skyttä <scop at cs132170.pp.htv.fi>
Vishal Bhatia <vishal at deja.com>
Vlad Harchev <hvv at hippo.ru>
Vladimir Alexiev <vladimir at cs.ualberta.ca>
W. Phillip Moore <wpm at ms.com>
Walt Mankowski <waltman at pobox.com>
Walter Briscoe <w.briscoe at ponl.com>
Warren Hyde <whyde at pezz.sps.mot.com>
Warren Jones <wjones at tc.fluke.com>
Wayne Berke <berke at panix.com>
Wayne Scott <wscott at ichips.intel.com>
Wayne Thompson <Wayne.Thompson at Ebay.sun.com>
Wilfredo Sánchez <wsanchez at mit.edu>
William J. Middleton <William.Middleton at oslo.mobil.telenor.no>
William Mann <wmann at avici.com>
William R Ward <hermit at BayView.COM>
William Setzer <William_Setzer at ncsu.edu>
William Williams <biwillia at cisco.com>
Winfried König <win at in.rhein-main.de>
Wolfgang Laun <Wolfgang.Laun at alcatel.at>
Xavier Noria <fxn at hashref.com>
YAMASHINA Hio <hio at ymir.co.jp>
Yary Hluchan
Yasushi Nakajima <sey at jkc.co.jp>
Yitzchak Scott-Thoennes <sthoenna at efn.org>
Yutaka OIWA <oiwa at is.s.u-tokyo.ac.jp>
Yutao Feng
Yuval Kogman
Yves Orton <demerphq at hotmail.com>
Zachary Miller <zcmiller at simon.er.usgs.gov>
--- NEW FILE: regexp.h ---
/* regexp.h
*
* Copyright (C) 1993, 1994, 1996, 1997, 1999, 2000, 2001, 2003,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Definitions etc. for regexp(3) routines.
*
* Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
* not the System V one.
*/
struct regnode {
U8 flags;
U8 type;
U16 next_off;
};
typedef struct regnode regnode;
struct reg_substr_data;
struct reg_data;
typedef struct regexp {
I32 *startp;
I32 *endp;
regnode *regstclass;
struct reg_substr_data *substrs;
char *precomp; /* pre-compilation regular expression */
struct reg_data *data; /* Additional data. */
char *subbeg; /* saved or original string
so \digit works forever. */
U32 *offsets; /* offset annotations 20001228 MJD */
I32 sublen; /* Length of string pointed by subbeg */
I32 refcnt;
I32 minlen; /* mininum possible length of $& */
I32 prelen; /* length of precomp */
U32 nparens; /* number of parentheses */
U32 lastparen; /* last paren matched */
U32 lastcloseparen; /* last paren matched */
U32 reganch; /* Internal use only +
Tainted information used by regexec? */
regnode program[1]; /* Unwarranted chumminess with compiler. */
} regexp;
#define ROPT_ANCH (ROPT_ANCH_BOL|ROPT_ANCH_MBOL|ROPT_ANCH_GPOS|ROPT_ANCH_SBOL)
#define ROPT_ANCH_SINGLE (ROPT_ANCH_SBOL|ROPT_ANCH_GPOS)
#define ROPT_ANCH_BOL 0x00001
#define ROPT_ANCH_MBOL 0x00002
#define ROPT_ANCH_SBOL 0x00004
#define ROPT_ANCH_GPOS 0x00008
#define ROPT_SKIP 0x00010
#define ROPT_IMPLICIT 0x00020 /* Converted .* to ^.* */
#define ROPT_NOSCAN 0x00040 /* Check-string always at start. */
#define ROPT_GPOS_SEEN 0x00080
#define ROPT_CHECK_ALL 0x00100
#define ROPT_LOOKBEHIND_SEEN 0x00200
#define ROPT_EVAL_SEEN 0x00400
#define ROPT_CANY_SEEN 0x00800
#define ROPT_SANY_SEEN ROPT_CANY_SEEN /* src bckwrd cmpt */
/* 0xf800 of reganch is used by PMf_COMPILETIME */
#define ROPT_UTF8 0x10000
#define ROPT_NAUGHTY 0x20000 /* how exponential is this pattern? */
#define ROPT_COPY_DONE 0x40000 /* subbeg is a copy of the string */
#define ROPT_TAINTED_SEEN 0x80000
#define ROPT_MATCH_UTF8 0x10000000 /* subbeg is utf-8 */
#define RE_USE_INTUIT_NOML 0x0100000 /* Best to intuit before matching */
#define RE_USE_INTUIT_ML 0x0200000
#define REINT_AUTORITATIVE_NOML 0x0400000 /* Can trust a positive answer */
#define REINT_AUTORITATIVE_ML 0x0800000
#define REINT_ONCE_NOML 0x1000000 /* Intuit can succed once only. */
#define REINT_ONCE_ML 0x2000000
#define RE_INTUIT_ONECHAR 0x4000000
#define RE_INTUIT_TAIL 0x8000000
#define RE_USE_INTUIT (RE_USE_INTUIT_NOML|RE_USE_INTUIT_ML)
#define REINT_AUTORITATIVE (REINT_AUTORITATIVE_NOML|REINT_AUTORITATIVE_ML)
#define REINT_ONCE (REINT_ONCE_NOML|REINT_ONCE_ML)
#define RX_MATCH_TAINTED(prog) ((prog)->reganch & ROPT_TAINTED_SEEN)
#define RX_MATCH_TAINTED_on(prog) ((prog)->reganch |= ROPT_TAINTED_SEEN)
#define RX_MATCH_TAINTED_off(prog) ((prog)->reganch &= ~ROPT_TAINTED_SEEN)
#define RX_MATCH_TAINTED_set(prog, t) ((t) \
? RX_MATCH_TAINTED_on(prog) \
: RX_MATCH_TAINTED_off(prog))
#define RX_MATCH_COPIED(prog) ((prog)->reganch & ROPT_COPY_DONE)
#define RX_MATCH_COPIED_on(prog) ((prog)->reganch |= ROPT_COPY_DONE)
#define RX_MATCH_COPIED_off(prog) ((prog)->reganch &= ~ROPT_COPY_DONE)
#define RX_MATCH_COPIED_set(prog,t) ((t) \
? RX_MATCH_COPIED_on(prog) \
: RX_MATCH_COPIED_off(prog))
#define RX_MATCH_UTF8(prog) ((prog)->reganch & ROPT_MATCH_UTF8)
#define RX_MATCH_UTF8_on(prog) ((prog)->reganch |= ROPT_MATCH_UTF8)
#define RX_MATCH_UTF8_off(prog) ((prog)->reganch &= ~ROPT_MATCH_UTF8)
#define RX_MATCH_UTF8_set(prog, t) ((t) \
? (RX_MATCH_UTF8_on(prog), (PL_reg_match_utf8 = 1)) \
: (RX_MATCH_UTF8_off(prog), (PL_reg_match_utf8 = 0)))
#define REXEC_COPY_STR 0x01 /* Need to copy the string. */
#define REXEC_CHECKED 0x02 /* check_substr already checked. */
#define REXEC_SCREAM 0x04 /* use scream table. */
#define REXEC_IGNOREPOS 0x08 /* \G matches at start. */
#define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g. */
#define REXEC_ML 0x20 /* $* was set. */
#define ReREFCNT_inc(re) ((void)(re && re->refcnt++), re)
#define ReREFCNT_dec(re) CALLREGFREE(aTHX_ re)
#define FBMcf_TAIL_DOLLAR 1
#define FBMcf_TAIL_DOLLARM 2
#define FBMcf_TAIL_Z 4
#define FBMcf_TAIL_z 8
#define FBMcf_TAIL (FBMcf_TAIL_DOLLAR|FBMcf_TAIL_DOLLARM|FBMcf_TAIL_Z|FBMcf_TAIL_z)
#define FBMrf_MULTILINE 1
struct re_scream_pos_data_s;
--- NEW FILE: thrdvar.h ---
/* thdrvar.h
*
* Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
=head1 Global Variables
*/
/***********************************************/
/* Global only to current thread */
/***********************************************/
/* Don't forget to re-run embed.pl to propagate changes! */
/* The 'T' prefix is only needed for vars that need appropriate #defines
* generated when built with or without USE_5005THREADS. It is also used
* to generate the appropriate export list for win32.
*
* When building without USE_5005THREADS, these variables will be truly global.
* When building without USE_5005THREADS but with MULTIPLICITY, these variables
* will be global per-interpreter. */
/* Important ones in the first cache line (if alignment is done right) */
#ifdef USE_5005THREADS
PERLVAR(interp, PerlInterpreter*) /* thread owner */
#endif
PERLVAR(Tstack_sp, SV **) /* top of the stack */
#ifdef OP_IN_REGISTER
PERLVAR(Topsave, OP *)
#else
PERLVAR(Top, OP *) /* currently executing op */
#endif
PERLVAR(Tcurpad, SV **) /* active pad (lexicals+tmps) */
PERLVAR(Tstack_base, SV **)
PERLVAR(Tstack_max, SV **)
PERLVAR(Tscopestack, I32 *) /* scopes we've ENTERed */
PERLVAR(Tscopestack_ix, I32)
PERLVAR(Tscopestack_max,I32)
PERLVAR(Tsavestack, ANY *) /* items that need to be restored
when LEAVEing scopes we've ENTERed */
PERLVAR(Tsavestack_ix, I32)
PERLVAR(Tsavestack_max, I32)
PERLVAR(Ttmps_stack, SV **) /* mortals we've made */
PERLVARI(Ttmps_ix, I32, -1)
PERLVARI(Ttmps_floor, I32, -1)
PERLVAR(Ttmps_max, I32)
PERLVAR(Tmarkstack, I32 *) /* stack_sp locations we're remembering */
PERLVAR(Tmarkstack_ptr, I32 *)
PERLVAR(Tmarkstack_max, I32 *)
PERLVAR(Tretstack, OP **) /* OPs we have postponed executing */
PERLVAR(Tretstack_ix, I32)
PERLVAR(Tretstack_max, I32)
PERLVAR(TSv, SV *) /* used to hold temporary values */
PERLVAR(TXpv, XPV *) /* used to hold temporary values */
/*
=for apidoc Amn|STRLEN|PL_na
A convenience variable which is typically used with C<SvPV> when one
doesn't care about the length of the string. It is usually more efficient
to either declare a local variable and use that instead or to use the
C<SvPV_nolen> macro.
=cut
*/
PERLVAR(Tna, STRLEN) /* for use in SvPV when length is
Not Applicable */
/* stat stuff */
PERLVAR(Tstatbuf, Stat_t)
PERLVAR(Tstatcache, Stat_t) /* _ */
PERLVAR(Tstatgv, GV *)
PERLVARI(Tstatname, SV *, Nullsv)
#ifdef HAS_TIMES
PERLVAR(Ttimesbuf, struct tms)
#endif
/* Fields used by magic variables such as $@, $/ and so on */
PERLVAR(Ttainted, bool) /* using variables controlled by $< */
PERLVAR(Tcurpm, PMOP *) /* what to do \ interps in REs from */
PERLVAR(Tnrs, SV *) /* placeholder: unused since 5.8.0 (5.7.2 patch #12027 for bug ID 20010815.012) */
/*
=for apidoc mn|SV*|PL_rs
The input record separator - C<$/> in Perl space.
=for apidoc mn|GV*|PL_last_in_gv
The GV which was last used for a filehandle input operation. (C<< <FH> >>)
=for apidoc mn|SV*|PL_ofs_sv
The output field separator - C<$,> in Perl space.
=cut
*/
PERLVAR(Trs, SV *) /* input record separator $/ */
PERLVAR(Tlast_in_gv, GV *) /* GV used in last <FH> */
PERLVAR(Tofs_sv, SV *) /* output field separator $, */
PERLVAR(Tdefoutgv, GV *) /* default FH for output */
PERLVARI(Tchopset, const char *, " \n-") /* $: */
PERLVAR(Tformtarget, SV *)
PERLVAR(Tbodytarget, SV *)
PERLVAR(Ttoptarget, SV *)
/* Stashes */
PERLVAR(Tdefstash, HV *) /* main symbol table */
PERLVAR(Tcurstash, HV *) /* symbol table for current package */
PERLVAR(Trestartop, OP *) /* propagating an error from croak? */
PERLVARI(Tcurcop, COP * VOL, &PL_compiling)
PERLVAR(Tin_eval, VOL int) /* trap "fatal" errors? */
PERLVAR(Tdelaymagic, int) /* ($<,$>) = ... */
PERLVARI(Tdirty, bool, FALSE) /* in the middle of tearing things down? */
PERLVAR(Tlocalizing, int) /* are we processing a local() list? */
PERLVAR(Tcurstack, AV *) /* THE STACK */
PERLVAR(Tcurstackinfo, PERL_SI *) /* current stack + context */
PERLVAR(Tmainstack, AV *) /* the stack when nothing funny is happening */
PERLVAR(Ttop_env, JMPENV *) /* ptr. to current sigjmp() environment */
PERLVAR(Tstart_env, JMPENV) /* empty startup sigjmp() environment */
#ifdef PERL_FLEXIBLE_EXCEPTIONS
PERLVARI(Tprotect, protect_proc_t, MEMBER_TO_FPTR(Perl_default_protect))
#endif
PERLVARI(Terrors, SV *, Nullsv) /* outstanding queued errors */
/* statics "owned" by various functions */
PERLVAR(Tav_fetch_sv, SV *) /* unused as of change #19268 */
PERLVAR(Thv_fetch_sv, SV *) /* unused as of change #19268 */
PERLVAR(Thv_fetch_ent_mh, HE*) /* owned by hv_fetch_ent() */
PERLVAR(Tmodcount, I32) /* how much mod()ification in assignment? */
PERLVAR(Tlastgotoprobe, OP*) /* from pp_ctl.c */
PERLVARI(Tdumpindent, I32, 4) /* # of blanks per dump indentation level */
/* sort stuff */
PERLVAR(Tsortcop, OP *) /* user defined sort routine */
PERLVAR(Tsortstash, HV *) /* which is in some package or other */
PERLVAR(Tfirstgv, GV *) /* $a */
PERLVAR(Tsecondgv, GV *) /* $b */
PERLVAR(Tsortcxix, I32) /* from pp_ctl.c */
/* float buffer */
PERLVAR(Tefloatbuf, char*)
PERLVAR(Tefloatsize, STRLEN)
/* regex stuff */
PERLVAR(Tscreamfirst, I32 *)
PERLVAR(Tscreamnext, I32 *)
PERLVARI(Tmaxscream, I32, -1)
PERLVAR(Tlastscream, SV *)
PERLVAR(Tregdummy, regnode) /* from regcomp.c */
PERLVAR(Tregcomp_parse, char*) /* Input-scan pointer. */
PERLVAR(Tregxend, char*) /* End of input for compile */
PERLVAR(Tregcode, regnode*) /* Code-emit pointer; ®dummy = don't */
PERLVAR(Tregnaughty, I32) /* How bad is this pattern? */
PERLVAR(Tregsawback, I32) /* Did we see \1, ...? */
PERLVAR(Tregprecomp, char *) /* uncompiled string. */
PERLVAR(Tregnpar, I32) /* () count. */
PERLVAR(Tregsize, I32) /* Code size. */
PERLVAR(Tregflags, U32) /* are we folding, multilining? */
PERLVAR(Tregseen, U32) /* from regcomp.c */
PERLVAR(Tseen_zerolen, I32) /* from regcomp.c */
PERLVAR(Tseen_evals, I32) /* from regcomp.c */
PERLVAR(Tregcomp_rx, regexp *) /* from regcomp.c */
PERLVAR(Textralen, I32) /* from regcomp.c */
PERLVAR(Tcolorset, int) /* from regcomp.c */
PERLVARA(Tcolors,6, char *) /* from regcomp.c */
PERLVAR(Treg_whilem_seen, I32) /* number of WHILEM in this expr */
PERLVAR(Treginput, char *) /* String-input pointer. */
PERLVAR(Tregbol, char *) /* Beginning of input, for ^ check. */
PERLVAR(Tregeol, char *) /* End of input, for $ check. */
PERLVAR(Tregstartp, I32 *) /* Pointer to startp array. */
PERLVAR(Tregendp, I32 *) /* Ditto for endp. */
PERLVAR(Treglastparen, U32 *) /* Similarly for lastparen. */
PERLVAR(Treglastcloseparen, U32 *) /* Similarly for lastcloseparen. */
PERLVAR(Tregtill, char *) /* How far we are required to go. */
PERLVAR(Tregcompat1, char) /* used to be regprev1 */
PERLVAR(Treg_start_tmp, char **) /* from regexec.c */
PERLVAR(Treg_start_tmpl,U32) /* from regexec.c */
PERLVAR(Tregdata, struct reg_data *)
/* from regexec.c renamed was data */
PERLVAR(Tbostr, char *) /* from regexec.c */
PERLVAR(Treg_flags, U32) /* from regexec.c */
PERLVAR(Treg_eval_set, I32) /* from regexec.c */
PERLVAR(Tregnarrate, I32) /* from regexec.c */
PERLVAR(Tregprogram, regnode *) /* from regexec.c */
PERLVARI(Tregindent, int, 0) /* from regexec.c */
PERLVAR(Tregcc, CURCUR *) /* from regexec.c */
PERLVAR(Treg_call_cc, struct re_cc_state *) /* from regexec.c */
PERLVAR(Treg_re, regexp *) /* from regexec.c */
PERLVAR(Treg_ganch, char *) /* position of \G */
PERLVAR(Treg_sv, SV *) /* what we match against */
PERLVAR(Treg_magic, MAGIC *) /* pos-magic of what we match */
PERLVAR(Treg_oldpos, I32) /* old pos of what we match */
PERLVARI(Treg_oldcurpm, PMOP*, NULL) /* curpm before match */
PERLVARI(Treg_curpm, PMOP*, NULL) /* curpm during match */
PERLVAR(Treg_oldsaved, char*) /* old saved substr during match */
PERLVAR(Treg_oldsavedlen, STRLEN) /* old length of saved substr during match */
PERLVAR(Treg_maxiter, I32) /* max wait until caching pos */
PERLVAR(Treg_leftiter, I32) /* wait until caching pos */
PERLVARI(Treg_poscache, char *, Nullch) /* cache of pos of WHILEM */
PERLVAR(Treg_poscache_size, STRLEN) /* size of pos cache of WHILEM */
PERLVARI(Tpeepp, peep_t, MEMBER_TO_FPTR(Perl_peep))
/* Pointer to peephole optimizer */
PERLVARI(Tregcompp, regcomp_t, MEMBER_TO_FPTR(Perl_pregcomp))
/* Pointer to REx compiler */
PERLVARI(Tregexecp, regexec_t, MEMBER_TO_FPTR(Perl_regexec_flags))
/* Pointer to REx executer */
PERLVARI(Tregint_start, re_intuit_start_t, MEMBER_TO_FPTR(Perl_re_intuit_start))
/* Pointer to optimized REx executer */
PERLVARI(Tregint_string,re_intuit_string_t, MEMBER_TO_FPTR(Perl_re_intuit_string))
/* Pointer to optimized REx string */
PERLVARI(Tregfree, regfree_t, MEMBER_TO_FPTR(Perl_pregfree))
/* Pointer to REx free()er */
PERLVARI(Treginterp_cnt,int, 0) /* Whether "Regexp" was interpolated. */
PERLVARI(Treg_starttry, char *, 0) /* -Dr: where regtry was called. */
PERLVARI(Twatchaddr, char **, 0)
PERLVAR(Twatchok, char *)
/* Note that the variables below are all explicitly referenced in the code
* as thr->whatever and therefore don't need the 'T' prefix. */
#ifdef USE_5005THREADS
PERLVAR(oursv, SV *)
PERLVAR(cvcache, HV *)
PERLVAR(self, perl_os_thread) /* Underlying thread object */
PERLVAR(flags, U32)
PERLVAR(threadsv, AV *) /* Per-thread SVs ($_, $@ etc.) */
PERLVAR(threadsvp, SV **) /* AvARRAY(threadsv) */
PERLVAR(specific, AV *) /* Thread-specific user data */
PERLVAR(errsv, SV *) /* Backing SV for $@ */
PERLVAR(mutex, perl_mutex) /* For the fields others can change */
PERLVAR(tid, U32)
PERLVAR(prev, struct perl_thread *)
PERLVAR(next, struct perl_thread *)
/* Circular linked list of threads */
#ifdef HAVE_THREAD_INTERN
PERLVAR(i, struct thread_intern)
/* Platform-dependent internals */
#endif
PERLVAR(trailing_nul, char) /* For the sake of thrsv and oursv */
PERLVAR(thr_done, bool) /* True when the thread has finished */
#endif /* USE_5005THREADS */
PERLVAR(Treg_match_utf8, bool) /* was what we matched against utf8 */
PERLVAR(Tcomppad, AV *) /* storage for lexically scoped temporaries */
--- NEW FILE: perlvars.h ---
/* perlvars.h
*
* Copyright (C) 1999, 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/****************/
/* Truly global */
/****************/
/* Don't forget to re-run embed.pl to propagate changes! */
/* This file describes the "global" variables used by perl
* This used to be in perl.h directly but we want to abstract out into
* distinct files which are per-thread, per-interpreter or really global,
* and how they're initialized.
*
* The 'G' prefix is only needed for vars that need appropriate #defines
* generated in embed*.h. Such symbols are also used to generate
* the appropriate export list for win32. */
/* global state */
PERLVAR(Gcurinterp, PerlInterpreter *)
/* currently running interpreter
* (initial parent interpreter under
* useithreads) */
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
PERLVAR(Gthr_key, perl_key) /* key to retrieve per-thread struct */
#endif
/* constants (these are not literals to facilitate pointer comparisons) */
PERLVARIC(GYes, char *, "1")
PERLVARIC(GNo, char *, "")
PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEF")
PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
/* XXX does anyone even use this? */
PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */
#if defined(MYMALLOC) && (defined(USE_5005THREADS) || defined(USE_ITHREADS))
PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */
#endif
#if defined(USE_ITHREADS)
PERLVAR(Gop_mutex, perl_mutex) /* Mutex for op refcounting */
#endif
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
PERLVAR(Gdollarzero_mutex, perl_mutex) /* Modifying $0 */
#endif
/* This is constant on most architectures, a global on OS/2 */
PERLVARI(Gsh_path, const char *, SH_PATH)/* full path of shell */
#ifndef PERL_MICRO
/* If Perl has to ignore SIGPFE, this is its saved state.
* See perl.h macros PERL_FPU_INIT and PERL_FPU_{PRE,POST}_EXEC. */
PERLVAR(Gsigfpe_saved, Sighandler_t)
#endif
/* Restricted hashes placeholder value.
* The contents are never used, only the address. */
PERLVAR(Gsv_placeholder, SV)
#ifndef PERL_MICRO
PERLVARI(Gcsighandlerp, Sighandler_t, Perl_csighandler) /* Pointer to C-level sighandler */
#endif
#ifndef PERL_USE_SAFE_PUTENV
PERLVARI(Guse_safe_putenv, int, 1)
#endif
--- NEW FILE: Changes5.8.1 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...16666 lines suppressed...]
Branch: maint-5.8/perl
+> (branch 34 files)
!> (integrate 343 files)
____________________________________________________________________________
[ 18079] By: jhi on 2002/11/04 02:06:17
Log: Integrate:
[ 17639]
It's all yours, Hugo.
(Flip Changes as Changes5.8, start new Changes)
[ 17644]
Copy perldelta as perl58delta, purge the perldelta.
The 17639 required editing to talk about 5.8.1 instead of
5.9.X; the 17644 required manual resolving since perldelta
was a bit confused between three Perl versions.
Branch: maint-5.8/perl
+> Changes5.8 pod/perl58delta.pod
!> Changes MANIFEST pod/perldelta.pod
--- NEW FILE: Changes5.8.2 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...1268 lines suppressed...]
!> ext/Sys/Syslog/t/syslog.t hints/powerux.sh
____________________________________________________________________________
[ 21393] By: nicholas on 2003/09/30 20:52:55
Log: Disarm the maint branch.
(Put the MAINTfoo local patch back in patchlevel.h following the
successful escape, er release, of 5.8.1)
Branch: maint-5.8/perl
! Changes patchlevel.h
____________________________________________________________________________
[ 21379] By: chip on 2003/09/25 18:10:01
Log: Relocate the mention of safe signals with POSIX::SigAction.
Branch: maint-5.8/perl
! pod/perl581delta.pod
____________________________________________________________________________
[ 21378] By: jhi on 2003/09/25 12:42:00
Log: perldelta turnover.
Branch: maint-5.8/perl
+ pod/perl581delta.pod
! MANIFEST pod.lst pod/perl.pod pod/perldelta.pod
! pod/perltoc.pod vms/descrip_mms.template win32/pod.mak
--- NEW FILE: Changes5.8.3 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...2136 lines suppressed...]
Log: Update changes
Branch: maint-5.8/perl
! Changes Changes5.8.2
____________________________________________________________________________
[ 21701] By: nicholas on 2003/11/11 20:08:50
Log: Remove carriage returns (which had slipped in)
Branch: maint-5.8/perl
! win32/Makefile win32/makefile.mk wince/compile-all.bat
! wince/registry.bat
____________________________________________________________________________
[ 21700] By: nicholas on 2003/11/11 19:28:07
Log: perldelta changeover
Branch: maint-5.8/perl
! pod/perldelta.pod
____________________________________________________________________________
[ 21699] By: nicholas on 2003/11/11 19:21:20
Log: Disarm the maint branch
Branch: maint-5.8/perl
+> Changes5.8.2 pod/perl582delta.pod
! Changes MANIFEST patchlevel.h
--- NEW FILE: Changes5.8.4 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...2451 lines suppressed...]
[ 22165] By: nicholas on 2004/01/17 14:42:52
Log: Create perl584delta.pod
(Not that I'm really proposing to start work on 5.8.4 today)
Branch: maint-5.8/perl
+ pod/perl584delta.pod
! MANIFEST Makefile.SH pod.lst pod/perl.pod pod/perltoc.pod
! vms/descrip_mms.template win32/Makefile win32/makefile.mk
! win32/pod.mak
____________________________________________________________________________
[ 22164] By: nicholas on 2004/01/17 14:00:17
Log: Disarm the maint branch
Branch: maint-5.8/perl
+> Changes5.8.3
! Changes MANIFEST patchlevel.h pod/perl583delta.pod
____________________________________________________________________________
[ 22152] By: nicholas on 2004/01/14 17:55:17
Log: Update Changes
Branch: maint-5.8/perl
! Changes
____________________________________________________________________________
--- NEW FILE: Changes5.8.5 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...1756 lines suppressed...]
Branch: maint-5.8/perl
+ pod/perl585delta.pod
! MANIFEST pod.lst pod/perl.pod pod/perltoc.pod
! vms/descrip_mms.template win32/Makefile win32/makefile.mk
! win32/pod.mak
____________________________________________________________________________
[ 22732] By: nicholas on 2004/04/22 09:21:28
Log: That was 5.8.4
Branch: maint-5.8/perl
! patchlevel.h
____________________________________________________________________________
[ 22731] By: nicholas on 2004/04/21 19:37:51
Log: Oink, oink, flap, flap!
Branch: maint-5.8/perl
! patchlevel.h pod/perlhist.pod
____________________________________________________________________________
[ 22730] By: nicholas on 2004/04/21 18:55:58
Log: Update Changes
Branch: maint-5.8/perl
! Changes patchlevel.h
--- NEW FILE: Changes5.8.6 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...1979 lines suppressed...]
[ 23144] By: nicholas on 2004/07/20 16:39:42
Log: Typo spotted by Jarkko. (But not by ispell, as it was another valid
word)
Branch: maint-5.8/perl
! pod/perl585delta.pod
____________________________________________________________________________
[ 23143] By: nicholas on 2004/07/19 21:51:18
Log: Disarm the maint branch
Branch: maint-5.8/perl
! patchlevel.h
____________________________________________________________________________
[ 23141] By: nicholas on 2004/07/19 14:25:58
Log: Break a leg
Branch: maint-5.8/perl
! patchlevel.h pod/perlhist.pod
____________________________________________________________________________
[ 23140] By: nicholas on 2004/07/19 14:06:59
Log: Update Changes
Branch: maint-5.8/perl
! Changes patchlevel.h
--- NEW FILE: regen_lib.pl ---
#!/usr/bin/perl -w
use strict;
use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write);
use Config; # Remember, this is running using an existing perl
# Common functions needed by the regen scripts
$Is_W32 = $^O eq 'MSWin32';
$Is_OS2 = $^O eq 'os2';
$Is_Cygwin = $^O eq 'cygwin';
$Is_NetWare = $Config{osname} eq 'NetWare';
if ($Is_NetWare) {
$Is_W32 = 0;
}
$Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare;
sub safer_unlink {
my @names = @_;
my $cnt = 0;
my $name;
foreach $name (@names) {
next unless -e $name;
chmod 0777, $name if $Needs_Write;
( CORE::unlink($name) and ++$cnt
or warn "Couldn't unlink $name: $!\n" );
}
return $cnt;
}
sub safer_rename_silent {
my ($from, $to) = @_;
# Some dosish systems can't rename over an existing file:
safer_unlink $to;
chmod 0600, $from if $Needs_Write;
rename $from, $to;
}
sub safer_rename {
my ($from, $to) = @_;
safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
}
1;
--- NEW FILE: regnodes.h ---
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by regcomp.pl from regcomp.sym.
Any changes made here will be lost!
*/
#define END 0 /* 0 End of program. */
#define SUCCEED 1 /* 0x1 Return from a subroutine, basically. */
#define BOL 2 /* 0x2 Match "" at beginning of line. */
#define MBOL 3 /* 0x3 Same, assuming multiline. */
#define SBOL 4 /* 0x4 Same, assuming singleline. */
#define EOS 5 /* 0x5 Match "" at end of string. */
#define EOL 6 /* 0x6 Match "" at end of line. */
#define MEOL 7 /* 0x7 Same, assuming multiline. */
#define SEOL 8 /* 0x8 Same, assuming singleline. */
#define BOUND 9 /* 0x9 Match "" at any word boundary */
#define BOUNDL 10 /* 0xa Match "" at any word boundary */
#define NBOUND 11 /* 0xb Match "" at any word non-boundary */
#define NBOUNDL 12 /* 0xc Match "" at any word non-boundary */
#define GPOS 13 /* 0xd Matches where last m//g left off. */
#define REG_ANY 14 /* 0xe Match any one character (except newline). */
#define SANY 15 /* 0xf Match any one character. */
#define CANY 16 /* 0x10 Match any one byte. */
#define ANYOF 17 /* 0x11 Match character in (or not in) this class. */
#define ALNUM 18 /* 0x12 Match any alphanumeric character */
#define ALNUML 19 /* 0x13 Match any alphanumeric char in locale */
#define NALNUM 20 /* 0x14 Match any non-alphanumeric character */
#define NALNUML 21 /* 0x15 Match any non-alphanumeric char in locale */
#define SPACE 22 /* 0x16 Match any whitespace character */
#define SPACEL 23 /* 0x17 Match any whitespace char in locale */
#define NSPACE 24 /* 0x18 Match any non-whitespace character */
#define NSPACEL 25 /* 0x19 Match any non-whitespace char in locale */
#define DIGIT 26 /* 0x1a Match any numeric character */
#define DIGITL 27 /* 0x1b Match any numeric character in locale */
#define NDIGIT 28 /* 0x1c Match any non-numeric character */
#define NDIGITL 29 /* 0x1d Match any non-numeric character in locale */
#define CLUMP 30 /* 0x1e Match any combining character sequence */
#define BRANCH 31 /* 0x1f Match this alternative, or the next... */
#define BACK 32 /* 0x20 Match "", "next" ptr points backward. */
#define EXACT 33 /* 0x21 Match this string (preceded by length). */
#define EXACTF 34 /* 0x22 Match this string, folded (prec. by length). */
#define EXACTFL 35 /* 0x23 Match this string, folded in locale (w/len). */
#define NOTHING 36 /* 0x24 Match empty string. */
#define TAIL 37 /* 0x25 Match empty string. Can jump here from outside. */
#define STAR 38 /* 0x26 Match this (simple) thing 0 or more times. */
#define PLUS 39 /* 0x27 Match this (simple) thing 1 or more times. */
#define CURLY 40 /* 0x28 Match this simple thing {n,m} times. */
#define CURLYN 41 /* 0x29 Match next-after-this simple thing */
#define CURLYM 42 /* 0x2a Match this medium-complex thing {n,m} times. */
#define CURLYX 43 /* 0x2b Match this complex thing {n,m} times. */
#define WHILEM 44 /* 0x2c Do curly processing and see if rest matches. */
#define OPEN 45 /* 0x2d Mark this point in input as start of #n. */
#define CLOSE 46 /* 0x2e Analogous to OPEN. */
#define REF 47 /* 0x2f Match some already matched string */
#define REFF 48 /* 0x30 Match already matched string, folded */
#define REFFL 49 /* 0x31 Match already matched string, folded in loc. */
#define IFMATCH 50 /* 0x32 Succeeds if the following matches. */
#define UNLESSM 51 /* 0x33 Fails if the following matches. */
#define SUSPEND 52 /* 0x34 "Independent" sub-RE. */
#define IFTHEN 53 /* 0x35 Switch, should be preceeded by switcher . */
#define GROUPP 54 /* 0x36 Whether the group matched. */
#define LONGJMP 55 /* 0x37 Jump far away. */
#define BRANCHJ 56 /* 0x38 BRANCH with long offset. */
#define EVAL 57 /* 0x39 Execute some Perl code. */
#define MINMOD 58 /* 0x3a Next operator is not greedy. */
#define LOGICAL 59 /* 0x3b Next opcode should set the flag only. */
#define RENUM 60 /* 0x3c Group with independently numbered parens. */
#define OPTIMIZED 61 /* 0x3d Placeholder for dump. */
#ifndef DOINIT
EXTCONST U8 PL_regkind[];
#else
EXTCONST U8 PL_regkind[] = {
END, /* END */
END, /* SUCCEED */
BOL, /* BOL */
BOL, /* MBOL */
BOL, /* SBOL */
EOL, /* EOS */
EOL, /* EOL */
EOL, /* MEOL */
EOL, /* SEOL */
BOUND, /* BOUND */
BOUND, /* BOUNDL */
NBOUND, /* NBOUND */
NBOUND, /* NBOUNDL */
GPOS, /* GPOS */
REG_ANY, /* REG_ANY */
REG_ANY, /* SANY */
REG_ANY, /* CANY */
ANYOF, /* ANYOF */
ALNUM, /* ALNUM */
ALNUM, /* ALNUML */
NALNUM, /* NALNUM */
NALNUM, /* NALNUML */
SPACE, /* SPACE */
SPACE, /* SPACEL */
NSPACE, /* NSPACE */
NSPACE, /* NSPACEL */
DIGIT, /* DIGIT */
DIGIT, /* DIGITL */
NDIGIT, /* NDIGIT */
NDIGIT, /* NDIGITL */
CLUMP, /* CLUMP */
BRANCH, /* BRANCH */
BACK, /* BACK */
EXACT, /* EXACT */
EXACT, /* EXACTF */
EXACT, /* EXACTFL */
NOTHING, /* NOTHING */
NOTHING, /* TAIL */
STAR, /* STAR */
PLUS, /* PLUS */
CURLY, /* CURLY */
CURLY, /* CURLYN */
CURLY, /* CURLYM */
CURLY, /* CURLYX */
WHILEM, /* WHILEM */
OPEN, /* OPEN */
CLOSE, /* CLOSE */
REF, /* REF */
REF, /* REFF */
REF, /* REFFL */
BRANCHJ, /* IFMATCH */
BRANCHJ, /* UNLESSM */
BRANCHJ, /* SUSPEND */
BRANCHJ, /* IFTHEN */
GROUPP, /* GROUPP */
LONGJMP, /* LONGJMP */
BRANCHJ, /* BRANCHJ */
EVAL, /* EVAL */
MINMOD, /* MINMOD */
LOGICAL, /* LOGICAL */
BRANCHJ, /* RENUM */
NOTHING, /* OPTIMIZED */
};
#endif
#ifdef REG_COMP_C
static const U8 regarglen[] = {
0, /* END */
0, /* SUCCEED */
0, /* BOL */
0, /* MBOL */
0, /* SBOL */
0, /* EOS */
0, /* EOL */
0, /* MEOL */
0, /* SEOL */
0, /* BOUND */
0, /* BOUNDL */
0, /* NBOUND */
0, /* NBOUNDL */
0, /* GPOS */
0, /* REG_ANY */
0, /* SANY */
0, /* CANY */
0, /* ANYOF */
0, /* ALNUM */
0, /* ALNUML */
0, /* NALNUM */
0, /* NALNUML */
0, /* SPACE */
0, /* SPACEL */
0, /* NSPACE */
0, /* NSPACEL */
0, /* DIGIT */
0, /* DIGITL */
0, /* NDIGIT */
0, /* NDIGITL */
0, /* CLUMP */
0, /* BRANCH */
0, /* BACK */
0, /* EXACT */
0, /* EXACTF */
0, /* EXACTFL */
0, /* NOTHING */
0, /* TAIL */
0, /* STAR */
0, /* PLUS */
EXTRA_SIZE(struct regnode_2), /* CURLY */
EXTRA_SIZE(struct regnode_2), /* CURLYN */
EXTRA_SIZE(struct regnode_2), /* CURLYM */
EXTRA_SIZE(struct regnode_2), /* CURLYX */
0, /* WHILEM */
EXTRA_SIZE(struct regnode_1), /* OPEN */
EXTRA_SIZE(struct regnode_1), /* CLOSE */
EXTRA_SIZE(struct regnode_1), /* REF */
EXTRA_SIZE(struct regnode_1), /* REFF */
EXTRA_SIZE(struct regnode_1), /* REFFL */
EXTRA_SIZE(struct regnode_1), /* IFMATCH */
EXTRA_SIZE(struct regnode_1), /* UNLESSM */
EXTRA_SIZE(struct regnode_1), /* SUSPEND */
EXTRA_SIZE(struct regnode_1), /* IFTHEN */
EXTRA_SIZE(struct regnode_1), /* GROUPP */
EXTRA_SIZE(struct regnode_1), /* LONGJMP */
EXTRA_SIZE(struct regnode_1), /* BRANCHJ */
EXTRA_SIZE(struct regnode_1), /* EVAL */
0, /* MINMOD */
0, /* LOGICAL */
EXTRA_SIZE(struct regnode_1), /* RENUM */
0, /* OPTIMIZED */
};
static const char reg_off_by_arg[] = {
0, /* END */
0, /* SUCCEED */
0, /* BOL */
0, /* MBOL */
0, /* SBOL */
0, /* EOS */
0, /* EOL */
0, /* MEOL */
0, /* SEOL */
0, /* BOUND */
0, /* BOUNDL */
0, /* NBOUND */
0, /* NBOUNDL */
0, /* GPOS */
0, /* REG_ANY */
0, /* SANY */
0, /* CANY */
0, /* ANYOF */
0, /* ALNUM */
0, /* ALNUML */
0, /* NALNUM */
0, /* NALNUML */
0, /* SPACE */
0, /* SPACEL */
0, /* NSPACE */
0, /* NSPACEL */
0, /* DIGIT */
0, /* DIGITL */
0, /* NDIGIT */
0, /* NDIGITL */
0, /* CLUMP */
0, /* BRANCH */
0, /* BACK */
0, /* EXACT */
0, /* EXACTF */
0, /* EXACTFL */
0, /* NOTHING */
0, /* TAIL */
0, /* STAR */
0, /* PLUS */
0, /* CURLY */
0, /* CURLYN */
0, /* CURLYM */
0, /* CURLYX */
0, /* WHILEM */
0, /* OPEN */
0, /* CLOSE */
0, /* REF */
0, /* REFF */
0, /* REFFL */
2, /* IFMATCH */
2, /* UNLESSM */
1, /* SUSPEND */
1, /* IFTHEN */
0, /* GROUPP */
1, /* LONGJMP */
1, /* BRANCHJ */
0, /* EVAL */
0, /* MINMOD */
0, /* LOGICAL */
1, /* RENUM */
0, /* OPTIMIZED */
};
#ifdef DEBUGGING
static const char * const reg_name[] = {
"END", /* 0 */
"SUCCEED", /* 0x1 */
"BOL", /* 0x2 */
"MBOL", /* 0x3 */
"SBOL", /* 0x4 */
"EOS", /* 0x5 */
"EOL", /* 0x6 */
"MEOL", /* 0x7 */
"SEOL", /* 0x8 */
"BOUND", /* 0x9 */
"BOUNDL", /* 0xa */
"NBOUND", /* 0xb */
"NBOUNDL", /* 0xc */
"GPOS", /* 0xd */
"REG_ANY", /* 0xe */
"SANY", /* 0xf */
"CANY", /* 0x10 */
"ANYOF", /* 0x11 */
"ALNUM", /* 0x12 */
"ALNUML", /* 0x13 */
"NALNUM", /* 0x14 */
"NALNUML", /* 0x15 */
"SPACE", /* 0x16 */
"SPACEL", /* 0x17 */
"NSPACE", /* 0x18 */
"NSPACEL", /* 0x19 */
"DIGIT", /* 0x1a */
"DIGITL", /* 0x1b */
"NDIGIT", /* 0x1c */
"NDIGITL", /* 0x1d */
"CLUMP", /* 0x1e */
"BRANCH", /* 0x1f */
"BACK", /* 0x20 */
"EXACT", /* 0x21 */
"EXACTF", /* 0x22 */
"EXACTFL", /* 0x23 */
"NOTHING", /* 0x24 */
"TAIL", /* 0x25 */
"STAR", /* 0x26 */
"PLUS", /* 0x27 */
"CURLY", /* 0x28 */
"CURLYN", /* 0x29 */
"CURLYM", /* 0x2a */
"CURLYX", /* 0x2b */
"WHILEM", /* 0x2c */
"OPEN", /* 0x2d */
"CLOSE", /* 0x2e */
"REF", /* 0x2f */
"REFF", /* 0x30 */
"REFFL", /* 0x31 */
"IFMATCH", /* 0x32 */
"UNLESSM", /* 0x33 */
"SUSPEND", /* 0x34 */
"IFTHEN", /* 0x35 */
"GROUPP", /* 0x36 */
"LONGJMP", /* 0x37 */
"BRANCHJ", /* 0x38 */
"EVAL", /* 0x39 */
"MINMOD", /* 0x3a */
"LOGICAL", /* 0x3b */
"RENUM", /* 0x3c */
"OPTIMIZED", /* 0x3d */
};
static const int reg_num = 62;
#endif /* DEBUGGING */
#endif /* REG_COMP_C */
/* ex: set ro: */
--- NEW FILE: README.beos ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.beos - Perl version 5.8+ on BeOS
=head1 DESCRIPTION
This file contains instructions how to build Perl under BeOS and lists
known problems.
=head1 BUILD AND INSTALL
=head2 Requirements
I have built and tested Perl 5.8.6 and 5.9.1 under BeOS R5 x86 net server.
I can't say anything with regard to PPC. Since Perl 5.8.0 had been released
for BeOS BONE, I suspect, there is a good chance, that it still compiles on
a BONE system. The only change I've made, that affects BONE systems is the
recognition of whether it is a BONE system or not in C<hints/beos.sh>. Now
network socket support should remain enabled on BONE systems. This might
as well break the build, though.
As more recent versions of autoconf require flock() support, I wrote a flock()
emulation (flock_server) and released it on BeBits:
http://www.bebits.com/app/4030
If you want to build a Perl with flock() support, you have to install this
package first.
=head2 Configure
With flock() support:
CFLAGS=-I/path/to/flock/server/headers ./configure.gnu \
--prefix=/boot/home/config
Replace C</path/to/flock/server/headers> with the path to the directory
containing the C<flock.h> header.
Without flock() support:
./configure.gnu --prefix=/boot/home/config
=head2 Build
With flock() support:
make LDLOADLIBS="-lnet -lflock"
Without flock() support:
make LDLOADLIBS="-lnet"
C<-lnet> is needed on net server systems only and if the compiler doesn't
add it automatically (Be's R5 gcc does, Oliver Tappe's gcc 2.95.3 does not).
=head2 Install
Install all perl files:
make install
Create a symlink for libperl:
cd ~/config/lib; ln -s perl5/5.8.6/BePC-beos/CORE/libperl.so .
Replace C<5.8.6> with your respective version of Perl.
=head1 KNOWN PROBLEMS
=over 4
=item *
Network socket support is disabled for BeOS R5 net server. I didn't dare yet
to try enabling it and see what problems occur.
=item *
The LFS (large file support) tests (C<t/op/lfs> and C<xt/Fcntl/t/syslfs>) are
disabled as seeking beyond 2 GB is broken according to jhi at iki.fi who was the
last one checking the BeOS port and updating this file before me. Haven't
checked this myself.
=item *
The C<t/io/fflush> test fails at #6. As far as I can tell, this is caused by
a bug in the BeOS pipes implementation that occurs when starting other child
processes. In the particular test case a C<system("perl -e 0")> flushes the
stdout pipe of another child process.
=item *
The C<ext/POSIX/t/waitpid> test fails at #1. After all child processes are
gone BeOS' waitpid(-1,...) returns 0 instead of -1 (as it should). No idea
how to fix this.
=back
=head1 CONTACT
For BeOS specifics problems feel free to mail to:
Ingo Weinhold <bonefish at cs.tu-berlin.de>
Last update: 2004-12-16
--- NEW FILE: README.openbsd ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
README.openbsd - Perl version 5 on OpenBSD systems
=head1 DESCRIPTION
This document describes various features of OpenBSD that will affect how Perl
version 5 (hereafter just Perl) is compiled and/or runs.
=head2 OpenBSD core dumps from getprotobyname_r and getservbyname_r with ithreads
When Perl is configured to use ithreads, it will use re-entrant library calls
in preference to non-re-entrant versions. There is an incompatability in
OpenBSD's C<getprotobyname_r> and C<getservbyname_r> function in versions 3.7
and later that will cause a SEGV when called without doing a C<bzero> on
their return structs prior to calling these functions. Current Perl's
should handle this problem correctly. Older threaded Perls (5.8.6 or earlier)
will run into this problem. If you want to run a threaded Perl on OpenBSD
3.7 or higher, you will need to upgrade to at least Perl 5.8.7.
=head1 AUTHOR
Steve Peters <steve at fisharerojo.org>
Please report any errors, updates, or suggestions to F<perlbug at perl.org>.
--- NEW FILE: README.freebsd ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
README.freebsd - Perl version 5 on FreeBSD systems
=head1 DESCRIPTION
This document describes various features of FreeBSD that will affect how Perl
version 5 (hereafter just Perl) is compiled and/or runs.
=head2 FreeBSD core dumps from readdir_r with ithreads
When perl is configured to use ithreads, it will use re-entrant library calls
in preference to non-re-entrant versions. There is a bug in FreeBSD's
C<readdir_r> function in versions 4.5 and earlier that can cause a SEGV when
reading large directories. A patch for FreeBSD libc is available
(see http://www.freebsd.org/cgi/query-pr.cgi?pr=misc/30631 )
which has been integrated into FreeBSD 4.6.
=head2 $^X doesn't always contain a full path in FreeBSD
perl 5.8.0 sets C<$^X> where possible to a full path by asking the operating
system. On FreeBSD the full path of the perl interpreter is found by reading
the symlink F</proc/curproc/file>. There is a bug on FreeBSD, where the
result of reading this symlink is can be wrong in certain circumstances
(see http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 ).
In these cases perl will fall back to the old behaviour of using C's
argv[0] value for C<$^X>.
=head2 Perl will no longer be part of "base FreeBSD"
Not as bad as it sounds--what this means is that Perl will no longer be
part of the B<kernel build system> of FreeBSD. Perl will still very
probably be part of the "default install", and in any case the latest
version will be in the ports system. The first FreeBSD version this
change will affect is 5.0, all 4.n versions will keep the status quo.
=head1 AUTHOR
Nicholas Clark <nick at ccl4.org>, collating wisdom supplied by Slaven Rezic
and Tim Bunce.
Please report any errors, updates, or suggestions to F<perlbug at perl.org>.
--- NEW FILE: embed.h ---
/* -*- buffer-read-only: t -*-
*
* embed.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by embed.pl from data in embed.fnc, embed.pl,
* pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
* Any changes made here will be lost!
*
* Edit those files and run 'make regen_headers' to effect changes.
*/
/* (Doing namespace management portably in C is really gross.) */
[...4186 lines suppressed...]
#endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
#if !defined(PERL_IMPLICIT_CONTEXT)
/* undefined symbols, point them back at the usual ones */
# define Perl_croak_nocontext Perl_croak
# define Perl_die_nocontext Perl_die
# define Perl_deb_nocontext Perl_deb
# define Perl_form_nocontext Perl_form
# define Perl_load_module_nocontext Perl_load_module
# define Perl_mess_nocontext Perl_mess
# define Perl_newSVpvf_nocontext Perl_newSVpvf
# define Perl_sv_catpvf_nocontext Perl_sv_catpvf
# define Perl_sv_setpvf_nocontext Perl_sv_setpvf
# define Perl_warn_nocontext Perl_warn
# define Perl_warner_nocontext Perl_warner
# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
#endif
/* ex: set ro: */
--- NEW FILE: README.irix ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
README.irix - Perl version 5 on Irix systems
=head1 DESCRIPTION
This document describes various features of Irix that will affect how Perl
version 5 (hereafter just Perl) is compiled and/or runs.
=head2 Building 32-bit Perl in Irix
Use
sh Configure -Dcc='cc -n32'
to compile Perl 32-bit. Don't bother with -n32 unless you have 7.1
or later compilers (use cc -version to check).
(Building 'cc -n32' is the default.)
=head2 Building 64-bit Perl in Irix
Use
sh Configure -Dcc='cc -64' -Duse64bitint
This requires require a 64-bit MIPS CPU (R8000, R10000, ...)
You can also use
sh Configure -Dcc='cc -64' -Duse64bitall
but that makes no difference compared with the -Duse64bitint because
of the C<cc -64>.
You can also do
sh Configure -Dcc='cc -n32' -Duse64bitint
to use long longs for the 64-bit integer type, in case you don't
have a 64-bit CPU.
If you are using gcc, just
sh Configure -Dcc=gcc -Duse64bitint
should be enough, the Configure should automatically probe for the
correct 64-bit settings.
=head2 About Compiler Versions of Irix
Some Irix cc versions, e.g. 7.3.1.1m (try cc -version) have been known
to have issues (coredumps) when compiling perl.c. If you've used
-OPT:fast_io=ON and this happens, try removing it. If that fails, or
you didn't use that, then try adjusting other optimization options
(-LNO, -INLINE, -O3 to -O2, etcetera). The compiler bug has been
reported to SGI. (Allen Smith <easmith at beatrice.rutgers.edu>)
=head2 Linker Problems in Irix
If you get complaints about so_locations then search in the file
hints/irix_6.sh for "lddflags" and do the suggested adjustments.
(David Billinghurst <David.Billinghurst at riotinto.com.au>)
=head2 Malloc in Irix
Do not try to use Perl's malloc, this will lead into very mysterious
errors (especially with -Duse64bitall).
=head2 Building with threads in Irix
Run Configure with -Duseithreads which will configure Perl with
the new Perl 5.8.0 "interpreter threads", see L<threads>.
The old Perl 5.005 threads is obsolete, unmaintained, and its use is
discouraged. If you really want it, run Configure with the
-Dusethreads -Duse5005threads options as described in INSTALL.
For either thread model and for Irix 6.2, you have to have the
following patches installed:
1404 Irix 6.2 Posix 1003.1b man pages
1645 Irix 6.2 & 6.3 POSIX header file updates
2000 Irix 6.2 Posix 1003.1b support modules
2254 Pthread library fixes
2401 6.2 all platform kernel rollup
B<IMPORTANT>: Without patch 2401, a kernel bug in Irix 6.2 will cause
your machine to panic and crash when running threaded perl. Irix 6.3
and later are okay.
Thanks to Hannu Napari <Hannu.Napari at hut.fi> for the IRIX
pthreads patches information.
=head2 Irix 5.3
While running Configure and when building, you are likely to get
quite a few of these warnings:
ld:
The shared object /usr/lib/libm.so did not resolve any symbols.
You may want to remove it from your link line.
Ignore them: in IRIX 5.3 there is no way to quieten ld about this.
During compilation you will see this warning from toke.c:
uopt: Warning: Perl_yylex: this procedure not optimized because it
exceeds size threshold; to optimize this procedure, use -Olimit option
with value >= 4252.
Ignore the warning.
In IRIX 5.3 and with Perl 5.8.1 (Perl 5.8.0 didn't compile in IRIX 5.3)
the following failures are known.
Failed Test Stat Wstat Total Fail Failed List of Failed
--------------------------------------------------------------------------
../ext/List/Util/t/shuffle.t 0 139 ?? ?? % ??
../lib/Math/Trig.t 255 65280 29 12 41.38% 24-29
../lib/sort.t 0 138 119 72 60.50% 48-119
56 tests and 474 subtests skipped.
Failed 3/811 test scripts, 99.63% okay. 78/75813 subtests failed, 99.90% okay.
They are suspected to be compiler errors (at least the shuffle.t
failure is known from some IRIX 6 setups) and math library errors
(the Trig.t failure), but since IRIX 5 is long since end-of-lifed,
further fixes for the IRIX are unlikely. If you can get gcc for 5.3,
you could try that, too, since gcc in IRIX 6 is a known workaround for
at least the shuffle.t and sort.t failures.
=head1 AUTHOR
Jarkko Hietaniemi <jhi at iki.fi>
Please report any errors, updates, or suggestions to F<perlbug at perl.org>.
--- NEW FILE: handy.h ---
/* handy.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
* 2000, 2001, 2002, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#if !defined(__STDC__)
#ifdef NULL
#undef NULL
#endif
#ifndef I286
# define NULL 0
#else
# define NULL 0L
#endif
#endif
#define Null(type) ((type)NULL)
/*
=head1 Handy Values
=for apidoc AmU||Nullch
Null character pointer.
=for apidoc AmU||Nullsv
Null SV pointer.
=cut
*/
#define Nullch Null(char*)
#define Nullfp Null(PerlIO*)
#define Nullsv Null(SV*)
#ifdef TRUE
#undef TRUE
#endif
#ifdef FALSE
#undef FALSE
#endif
#define TRUE (1)
#define FALSE (0)
/* XXX Configure ought to have a test for a boolean type, if I can
just figure out all the headers such a test needs.
Andy Dougherty August 1996
*/
/* bool is built-in for g++-2.6.3 and later, which might be used
for extensions. <_G_config.h> defines _G_HAVE_BOOL, but we can't
be sure _G_config.h will be included before this file. _G_config.h
also defines _G_HAVE_BOOL for both gcc and g++, but only g++
actually has bool. Hence, _G_HAVE_BOOL is pretty useless for us.
g++ can be identified by __GNUG__.
Andy Dougherty February 2000
*/
#ifdef __GNUG__ /* GNU g++ has bool built-in */
# ifndef HAS_BOOL
# define HAS_BOOL 1
# endif
#endif
/* The NeXT dynamic loader headers will not build with the bool macro
So declare them now to clear confusion.
*/
#if defined(NeXT) || defined(__NeXT__)
# undef FALSE
# undef TRUE
typedef enum bool { FALSE = 0, TRUE = 1 } bool;
# define ENUM_BOOL 1
# ifndef HAS_BOOL
# define HAS_BOOL 1
# endif /* !HAS_BOOL */
#endif /* NeXT || __NeXT__ */
#ifndef HAS_BOOL
# if defined(UTS) || defined(VMS)
# define bool int
# else
# define bool char
# endif
# define HAS_BOOL 1
#endif
/* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
* XXX Should really be a Configure probe, with HAS__FUNCTION__
* and FUNCTION__ as results.
* XXX Similarly, a Configure probe for __FILE__ and __LINE__ is needed. */
#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined(__SUNPRO_C)) /* C99 or close enough. */
# define FUNCTION__ __func__
#else
# if (defined(_MSC_VER) && _MSC_VER < 1300) || /* Pre-MSVC 7.0 has neither __func__ nor __FUNCTION and no good workarounds, either. */ \
(defined(__DECC_VER)) /* Tru64 or VMS, and strict C89 being used, but not modern enough cc (in Tur64, -c99 not known, only -std1). */
# define FUNCTION__ ""
# else
# define FUNCTION__ __FUNCTION__ /* Common extension. */
# endif
#endif
/* XXX A note on the perl source internal type system. The
original intent was that I32 be *exactly* 32 bits.
Currently, we only guarantee that I32 is *at least* 32 bits.
Specifically, if int is 64 bits, then so is I32. (This is the case
for the Cray.) This has the advantage of meshing nicely with
standard library calls (where we pass an I32 and the library is
expecting an int), but the disadvantage that an I32 is not 32 bits.
Andy Dougherty August 1996
There is no guarantee that there is *any* integral type with
exactly 32 bits. It is perfectly legal for a system to have
sizeof(short) == sizeof(int) == sizeof(long) == 8.
Similarly, there is no guarantee that I16 and U16 have exactly 16
bits.
For dealing with issues that may arise from various 32/64-bit
systems, we will ask Configure to check out
SHORTSIZE == sizeof(short)
INTSIZE == sizeof(int)
LONGSIZE == sizeof(long)
LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG)
PTRSIZE == sizeof(void *)
DOUBLESIZE == sizeof(double)
LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE).
*/
#ifdef I_INTTYPES /* e.g. Linux has int64_t without <inttypes.h> */
# include <inttypes.h>
# ifdef INT32_MIN_BROKEN
# undef INT32_MIN
# define INT32_MIN (-2147483647-1)
# endif
# ifdef INT64_MIN_BROKEN
# undef INT64_MIN
# define INT64_MIN (-9223372036854775807LL-1)
# endif
#endif
typedef I8TYPE I8;
typedef U8TYPE U8;
typedef I16TYPE I16;
typedef U16TYPE U16;
typedef I32TYPE I32;
typedef U32TYPE U32;
#ifdef PERL_CORE
# ifdef HAS_QUAD
typedef I64TYPE I64;
typedef U64TYPE U64;
# endif
#endif /* PERL_CORE */
#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
# ifndef UINT64_C /* usually from <inttypes.h> */
# if defined(HAS_LONG_LONG) && QUADKIND == QUAD_IS_LONG_LONG
# define INT64_C(c) CAT2(c,LL)
# define UINT64_C(c) CAT2(c,ULL)
# else
# if LONGSIZE == 8 && QUADKIND == QUAD_IS_LONG
# define INT64_C(c) CAT2(c,L)
# define UINT64_C(c) CAT2(c,UL)
# else
# define INT64_C(c) ((I64TYPE)(c))
# define UINT64_C(c) ((U64TYPE)(c))
# endif
# endif
# endif
#endif
/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
#if defined(HAS_MALLOC_SIZE) && defined(HAS_MALLOC_GOOD_SIZE)
/* Not (yet) used at top level, but mention them for metaconfig */
#endif
/* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE,
I64SIZE, and U64SIZE here so that metaconfig pulls them in. */
#if defined(UINT8_MAX) && defined(INT16_MAX) && defined(INT32_MAX)
/* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type.
Please search CHAR_MAX in perl.h for further details. */
#define U8_MAX UINT8_MAX
#define U8_MIN UINT8_MIN
#define I16_MAX INT16_MAX
#define I16_MIN INT16_MIN
#define U16_MAX UINT16_MAX
#define U16_MIN UINT16_MIN
#define I32_MAX INT32_MAX
#define I32_MIN INT32_MIN
#ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
# define U32_MAX UINT32_MAX
#else
# define U32_MAX 4294967295U
#endif
#define U32_MIN UINT32_MIN
#else
/* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type.
Please search CHAR_MAX in perl.h for further details. */
#define U8_MAX PERL_UCHAR_MAX
#define U8_MIN PERL_UCHAR_MIN
#define I16_MAX PERL_SHORT_MAX
#define I16_MIN PERL_SHORT_MIN
#define U16_MAX PERL_USHORT_MAX
#define U16_MIN PERL_USHORT_MIN
#if LONGSIZE > 4
# define I32_MAX PERL_INT_MAX
# define I32_MIN PERL_INT_MIN
# define U32_MAX PERL_UINT_MAX
# define U32_MIN PERL_UINT_MIN
#else
# define I32_MAX PERL_LONG_MAX
# define I32_MIN PERL_LONG_MIN
# define U32_MAX PERL_ULONG_MAX
# define U32_MIN PERL_ULONG_MIN
#endif
#endif
/* log(2) is pretty close to 0.30103, just in case anyone is grepping for it */
#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log2(10) =~ 146/485 */
#define TYPE_DIGITS(T) BIT_DIGITS(sizeof(T) * 8)
#define TYPE_CHARS(T) (TYPE_DIGITS(T) + 2) /* sign, NUL */
#define Ctl(ch) ((ch) & 037)
/*
=head1 Miscellaneous Functions
=for apidoc Am|bool|strNE|char* s1|char* s2
Test two strings to see if they are different. Returns true or
false.
=for apidoc Am|bool|strEQ|char* s1|char* s2
Test two strings to see if they are equal. Returns true or false.
=for apidoc Am|bool|strLT|char* s1|char* s2
Test two strings to see if the first, C<s1>, is less than the second,
C<s2>. Returns true or false.
=for apidoc Am|bool|strLE|char* s1|char* s2
Test two strings to see if the first, C<s1>, is less than or equal to the
second, C<s2>. Returns true or false.
=for apidoc Am|bool|strGT|char* s1|char* s2
Test two strings to see if the first, C<s1>, is greater than the second,
C<s2>. Returns true or false.
=for apidoc Am|bool|strGE|char* s1|char* s2
Test two strings to see if the first, C<s1>, is greater than or equal to
the second, C<s2>. Returns true or false.
=for apidoc Am|bool|strnNE|char* s1|char* s2|STRLEN len
Test two strings to see if they are different. The C<len> parameter
indicates the number of bytes to compare. Returns true or false. (A
wrapper for C<strncmp>).
=for apidoc Am|bool|strnEQ|char* s1|char* s2|STRLEN len
Test two strings to see if they are equal. The C<len> parameter indicates
the number of bytes to compare. Returns true or false. (A wrapper for
C<strncmp>).
=cut
*/
#define strNE(s1,s2) (strcmp(s1,s2))
#define strEQ(s1,s2) (!strcmp(s1,s2))
#define strLT(s1,s2) (strcmp(s1,s2) < 0)
#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
#define strGT(s1,s2) (strcmp(s1,s2) > 0)
#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
#ifdef HAS_MEMCMP
# define memNE(s1,s2,l) (memcmp(s1,s2,l))
# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
#else
# define memNE(s1,s2,l) (bcmp(s1,s2,l))
# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
#endif
/*
* Character classes.
*
* Unfortunately, the introduction of locales means that we
* can't trust isupper(), etc. to tell the truth. And when
* it comes to /\w+/ with tainting enabled, we *must* be able
* to trust our character classes.
*
* Therefore, the default tests in the text of Perl will be
* independent of locale. Any code that wants to depend on
* the current locale will use the tests that begin with "lc".
*/
#ifdef HAS_SETLOCALE /* XXX Is there a better test for this? */
# ifndef CTYPE256
# define CTYPE256
# endif
#endif
/*
=head1 Character classes
=for apidoc Am|bool|isALNUM|char ch
Returns a boolean indicating whether the C C<char> is an ASCII alphanumeric
character (including underscore) or digit.
=for apidoc Am|bool|isALPHA|char ch
Returns a boolean indicating whether the C C<char> is an ASCII alphabetic
character.
=for apidoc Am|bool|isSPACE|char ch
Returns a boolean indicating whether the C C<char> is whitespace.
=for apidoc Am|bool|isDIGIT|char ch
Returns a boolean indicating whether the C C<char> is an ASCII
digit.
=for apidoc Am|bool|isUPPER|char ch
Returns a boolean indicating whether the C C<char> is an uppercase
character.
=for apidoc Am|bool|isLOWER|char ch
Returns a boolean indicating whether the C C<char> is a lowercase
character.
=for apidoc Am|char|toUPPER|char ch
Converts the specified character to uppercase.
=for apidoc Am|char|toLOWER|char ch
Converts the specified character to lowercase.
=cut
*/
#define isALNUM(c) (isALPHA(c) || isDIGIT(c) || (c) == '_')
#define isIDFIRST(c) (isALPHA(c) || (c) == '_')
#define isALPHA(c) (isUPPER(c) || isLOWER(c))
#define isSPACE(c) \
((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f')
#define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
#define isBLANK(c) ((c) == ' ' || (c) == '\t')
#define isDIGIT(c) ((c) >= '0' && (c) <= '9')
#ifdef EBCDIC
/* In EBCDIC we do not do locales: therefore() isupper() is fine. */
# define isUPPER(c) isupper(c)
# define isLOWER(c) islower(c)
# define isALNUMC(c) isalnum(c)
# define isASCII(c) isascii(c)
# define isCNTRL(c) iscntrl(c)
# define isGRAPH(c) isgraph(c)
# define isPRINT(c) isprint(c)
# define isPUNCT(c) ispunct(c)
# define isXDIGIT(c) isxdigit(c)
# define toUPPER(c) toupper(c)
# define toLOWER(c) tolower(c)
#else
# define isUPPER(c) ((c) >= 'A' && (c) <= 'Z')
# define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
# define isASCII(c) ((c) <= 127)
# define isCNTRL(c) ((c) < ' ' || (c) == 127)
# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
# define isPRINT(c) (((c) > 32 && (c) < 127) || (c) == ' ')
# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
# define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c))
# define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c))
#endif
#ifdef USE_NEXT_CTYPE
# define isALNUM_LC(c) \
(NXIsAlNum((unsigned int)(c)) || (char)(c) == '_')
# define isIDFIRST_LC(c) \
(NXIsAlpha((unsigned int)(c)) || (char)(c) == '_')
# define isALPHA_LC(c) NXIsAlpha((unsigned int)(c))
# define isSPACE_LC(c) NXIsSpace((unsigned int)(c))
# define isDIGIT_LC(c) NXIsDigit((unsigned int)(c))
# define isUPPER_LC(c) NXIsUpper((unsigned int)(c))
# define isLOWER_LC(c) NXIsLower((unsigned int)(c))
# define isALNUMC_LC(c) NXIsAlNum((unsigned int)(c))
# define isCNTRL_LC(c) NXIsCntrl((unsigned int)(c))
# define isGRAPH_LC(c) NXIsGraph((unsigned int)(c))
# define isPRINT_LC(c) NXIsPrint((unsigned int)(c))
# define isPUNCT_LC(c) NXIsPunct((unsigned int)(c))
# define toUPPER_LC(c) NXToUpper((unsigned int)(c))
# define toLOWER_LC(c) NXToLower((unsigned int)(c))
#else /* !USE_NEXT_CTYPE */
# if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
# define isALNUM_LC(c) (isalnum((unsigned char)(c)) || (char)(c) == '_')
# define isIDFIRST_LC(c) (isalpha((unsigned char)(c)) || (char)(c) == '_')
# define isALPHA_LC(c) isalpha((unsigned char)(c))
# define isSPACE_LC(c) isspace((unsigned char)(c))
# define isDIGIT_LC(c) isdigit((unsigned char)(c))
# define isUPPER_LC(c) isupper((unsigned char)(c))
# define isLOWER_LC(c) islower((unsigned char)(c))
# define isALNUMC_LC(c) isalnum((unsigned char)(c))
# define isCNTRL_LC(c) iscntrl((unsigned char)(c))
# define isGRAPH_LC(c) isgraph((unsigned char)(c))
# define isPRINT_LC(c) isprint((unsigned char)(c))
# define isPUNCT_LC(c) ispunct((unsigned char)(c))
# define toUPPER_LC(c) toupper((unsigned char)(c))
# define toLOWER_LC(c) tolower((unsigned char)(c))
# else
# define isALNUM_LC(c) (isascii(c) && (isalnum(c) || (c) == '_'))
# define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_'))
# define isALPHA_LC(c) (isascii(c) && isalpha(c))
# define isSPACE_LC(c) (isascii(c) && isspace(c))
# define isDIGIT_LC(c) (isascii(c) && isdigit(c))
# define isUPPER_LC(c) (isascii(c) && isupper(c))
# define isLOWER_LC(c) (isascii(c) && islower(c))
# define isALNUMC_LC(c) (isascii(c) && isalnum(c))
# define isCNTRL_LC(c) (isascii(c) && iscntrl(c))
# define isGRAPH_LC(c) (isascii(c) && isgraph(c))
# define isPRINT_LC(c) (isascii(c) && isprint(c))
# define isPUNCT_LC(c) (isascii(c) && ispunct(c))
# define toUPPER_LC(c) toupper(c)
# define toLOWER_LC(c) tolower(c)
# endif
#endif /* USE_NEXT_CTYPE */
#define isPSXSPC_LC(c) (isSPACE_LC(c) || (c) == '\v')
#define isBLANK_LC(c) isBLANK(c) /* could be wrong */
#define isALNUM_uni(c) is_uni_alnum(c)
#define isIDFIRST_uni(c) is_uni_idfirst(c)
#define isALPHA_uni(c) is_uni_alpha(c)
#define isSPACE_uni(c) is_uni_space(c)
#define isDIGIT_uni(c) is_uni_digit(c)
#define isUPPER_uni(c) is_uni_upper(c)
#define isLOWER_uni(c) is_uni_lower(c)
#define isALNUMC_uni(c) is_uni_alnumc(c)
#define isASCII_uni(c) is_uni_ascii(c)
#define isCNTRL_uni(c) is_uni_cntrl(c)
#define isGRAPH_uni(c) is_uni_graph(c)
#define isPRINT_uni(c) is_uni_print(c)
#define isPUNCT_uni(c) is_uni_punct(c)
#define isXDIGIT_uni(c) is_uni_xdigit(c)
#define toUPPER_uni(c,s,l) to_uni_upper(c,s,l)
#define toTITLE_uni(c,s,l) to_uni_title(c,s,l)
#define toLOWER_uni(c,s,l) to_uni_lower(c,s,l)
#define toFOLD_uni(c,s,l) to_uni_fold(c,s,l)
#define isPSXSPC_uni(c) (isSPACE_uni(c) ||(c) == '\f')
#define isBLANK_uni(c) isBLANK(c) /* could be wrong */
#define isALNUM_LC_uvchr(c) (c < 256 ? isALNUM_LC(c) : is_uni_alnum_lc(c))
#define isIDFIRST_LC_uvchr(c) (c < 256 ? isIDFIRST_LC(c) : is_uni_idfirst_lc(c))
#define isALPHA_LC_uvchr(c) (c < 256 ? isALPHA_LC(c) : is_uni_alpha_lc(c))
#define isSPACE_LC_uvchr(c) (c < 256 ? isSPACE_LC(c) : is_uni_space_lc(c))
#define isDIGIT_LC_uvchr(c) (c < 256 ? isDIGIT_LC(c) : is_uni_digit_lc(c))
#define isUPPER_LC_uvchr(c) (c < 256 ? isUPPER_LC(c) : is_uni_upper_lc(c))
#define isLOWER_LC_uvchr(c) (c < 256 ? isLOWER_LC(c) : is_uni_lower_lc(c))
#define isALNUMC_LC_uvchr(c) (c < 256 ? isALNUMC_LC(c) : is_uni_alnumc_lc(c))
#define isCNTRL_LC_uvchr(c) (c < 256 ? isCNTRL_LC(c) : is_uni_cntrl_lc(c))
#define isGRAPH_LC_uvchr(c) (c < 256 ? isGRAPH_LC(c) : is_uni_graph_lc(c))
#define isPRINT_LC_uvchr(c) (c < 256 ? isPRINT_LC(c) : is_uni_print_lc(c))
#define isPUNCT_LC_uvchr(c) (c < 256 ? isPUNCT_LC(c) : is_uni_punct_lc(c))
#define isPSXSPC_LC_uni(c) (isSPACE_LC_uni(c) ||(c) == '\f')
#define isBLANK_LC_uni(c) isBLANK(c) /* could be wrong */
#define isALNUM_utf8(p) is_utf8_alnum(p)
/* The ID_Start of Unicode is quite limiting: it assumes a L-class
* character (meaning that you cannot have, say, a CJK character).
* Instead, let's allow ID_Continue but not digits. */
#define isIDFIRST_utf8(p) (is_utf8_idcont(p) && !is_utf8_digit(p))
#define isALPHA_utf8(p) is_utf8_alpha(p)
#define isSPACE_utf8(p) is_utf8_space(p)
#define isDIGIT_utf8(p) is_utf8_digit(p)
#define isUPPER_utf8(p) is_utf8_upper(p)
#define isLOWER_utf8(p) is_utf8_lower(p)
#define isALNUMC_utf8(p) is_utf8_alnumc(p)
#define isASCII_utf8(p) is_utf8_ascii(p)
#define isCNTRL_utf8(p) is_utf8_cntrl(p)
#define isGRAPH_utf8(p) is_utf8_graph(p)
#define isPRINT_utf8(p) is_utf8_print(p)
#define isPUNCT_utf8(p) is_utf8_punct(p)
#define isXDIGIT_utf8(p) is_utf8_xdigit(p)
#define toUPPER_utf8(p,s,l) to_utf8_upper(p,s,l)
#define toTITLE_utf8(p,s,l) to_utf8_title(p,s,l)
#define toLOWER_utf8(p,s,l) to_utf8_lower(p,s,l)
#define isPSXSPC_utf8(c) (isSPACE_utf8(c) ||(c) == '\f')
#define isBLANK_utf8(c) isBLANK(c) /* could be wrong */
#define isALNUM_LC_utf8(p) isALNUM_LC_uvchr(utf8_to_uvchr(p, 0))
#define isIDFIRST_LC_utf8(p) isIDFIRST_LC_uvchr(utf8_to_uvchr(p, 0))
#define isALPHA_LC_utf8(p) isALPHA_LC_uvchr(utf8_to_uvchr(p, 0))
#define isSPACE_LC_utf8(p) isSPACE_LC_uvchr(utf8_to_uvchr(p, 0))
#define isDIGIT_LC_utf8(p) isDIGIT_LC_uvchr(utf8_to_uvchr(p, 0))
#define isUPPER_LC_utf8(p) isUPPER_LC_uvchr(utf8_to_uvchr(p, 0))
#define isLOWER_LC_utf8(p) isLOWER_LC_uvchr(utf8_to_uvchr(p, 0))
#define isALNUMC_LC_utf8(p) isALNUMC_LC_uvchr(utf8_to_uvchr(p, 0))
#define isCNTRL_LC_utf8(p) isCNTRL_LC_uvchr(utf8_to_uvchr(p, 0))
#define isGRAPH_LC_utf8(p) isGRAPH_LC_uvchr(utf8_to_uvchr(p, 0))
#define isPRINT_LC_utf8(p) isPRINT_LC_uvchr(utf8_to_uvchr(p, 0))
#define isPUNCT_LC_utf8(p) isPUNCT_LC_uvchr(utf8_to_uvchr(p, 0))
#define isPSXSPC_LC_utf8(c) (isSPACE_LC_utf8(c) ||(c) == '\f')
#define isBLANK_LC_utf8(c) isBLANK(c) /* could be wrong */
#ifdef EBCDIC
# ifdef PERL_IMPLICIT_CONTEXT
# define toCTRL(c) Perl_ebcdic_control(aTHX_ c)
# else
# define toCTRL Perl_ebcdic_control
# endif
#else
/* This conversion works both ways, strangely enough. */
# define toCTRL(c) (toUPPER(c) ^ 64)
#endif
/* Line numbers are unsigned, 32 bits. */
typedef U32 line_t;
#define NOLINE ((line_t) 4294967295UL)
/*
=head1 SV Manipulation Functions
=for apidoc Am|SV*|NEWSV|int id|STRLEN len
Creates a new SV. A non-zero C<len> parameter indicates the number of
bytes of preallocated string space the SV should have. An extra byte for a
tailing NUL is also reserved. (SvPOK is not set for the SV even if string
space is allocated.) The reference count for the new SV is set to 1.
C<id> is an integer id between 0 and 1299 (used to identify leaks).
=head1 Memory Management
=for apidoc Am|void|Newx|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<malloc> function.
=for apidoc Am|void|Newxc|void* ptr|int nitems|type|cast
The XSUB-writer's interface to the C C<malloc> function, with
cast.
=for apidoc Am|void|Newxz|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<malloc> function. The allocated
memory is zeroed with C<memzero>.
In 5.9.3, we removed the 1st parameter, a debug aid, from the api. It
was used to uniquely identify each usage of these allocation
functions, but was deemed unnecessary with the availability of better
memory tracking tools, valgrind for example.
=for apidoc Am|void|Renew|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<realloc> function.
=for apidoc Am|void|Renewc|void* ptr|int nitems|type|cast
The XSUB-writer's interface to the C C<realloc> function, with
cast.
=for apidoc Am|void|Safefree|void* ptr
The XSUB-writer's interface to the C C<free> function.
=for apidoc Am|void|Move|void* src|void* dest|int nitems|type
The XSUB-writer's interface to the C C<memmove> function. The C<src> is the
source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
the type. Can do overlapping moves. See also C<Copy>.
=for apidoc Am|void *|MoveD|void* src|void* dest|int nitems|type
Like C<Move> but returns dest. Useful for encouraging compilers to tail-call
optimise.
=for apidoc Am|void|Copy|void* src|void* dest|int nitems|type
The XSUB-writer's interface to the C C<memcpy> function. The C<src> is the
source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
the type. May fail on overlapping copies. See also C<Move>.
=for apidoc Am|void *|CopyD|void* src|void* dest|int nitems|type
Like C<Copy> but returns dest. Useful for encouraging compilers to tail-call
optimise.
=for apidoc Am|void|Zero|void* dest|int nitems|type
The XSUB-writer's interface to the C C<memzero> function. The C<dest> is the
destination, C<nitems> is the number of items, and C<type> is the type.
=for apidoc Am|void *|ZeroD|void* dest|int nitems|type
Like C<Zero> but returns dest. Useful for encouraging compilers to tail-call
optimise.
=for apidoc Am|void|StructCopy|type src|type dest|type
This is an architecture-independent macro to copy one structure to another.
=for apidoc Am|void|Poison|void* dest|int nitems|type
Fill up memory with a pattern (byte 0xAB over and over again) that
hopefully catches attempts to access uninitialized memory.
=cut */
#define NEWSV(x,len) newSV(len)
#ifdef PERL_MALLOC_WRAP
#define MEM_WRAP_CHECK(n,t) MEM_WRAP_CHECK_1(n,t,PL_memory_wrap)
#define MEM_WRAP_CHECK_1(n,t,a) \
(void)(sizeof(t) > 1 && (n) > ((MEM_SIZE)~0)/sizeof(t) && (Perl_croak_nocontext(a),0))
#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > (MEM_SIZE)~0 - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (Perl_croak_nocontext(PL_memory_wrap),0):0),((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
#else
#define MEM_WRAP_CHECK(n,t)
#define MEM_WRAP_CHECK_1(n,t,a)
#define MEM_WRAP_CHECK_2(n,t,a,b)
#define MEM_WRAP_CHECK_(n,t)
#define PERL_STRLEN_ROUNDUP(n) (((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
#endif
#define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
#define Newxc(v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
#define Newxz(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
memzero((char*)(v), (n)*sizeof(t))
/* pre 5.9.x compatibility */
#define New(x,v,n,t) Newx(v,n,t)
#define Newc(x,v,n,t,c) Newxc(v,n,t,c)
#define Newz(x,v,n,t) Newxz(v,n,t)
#define Renew(v,n,t) \
(v = (MEM_WRAP_CHECK_(n,t) (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
#define Renewc(v,n,t,c) \
(v = (MEM_WRAP_CHECK_(n,t) (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
#ifdef PERL_POISON
#define Safefree(d) \
(d ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0)
#else
#define Safefree(d) safefree((Malloc_t)(d))
#endif
#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
#ifdef HAS_MEMSET
#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
#else
/* Using bzero(), which returns void. */
#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
#endif
#define Poison(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
#ifdef USE_STRUCT_COPY
#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
#else
#define StructCopy(s,d,t) Copy(s,d,1,t)
#endif
#define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
#ifdef NEED_VA_COPY
# ifdef va_copy
# define Perl_va_copy(s, d) va_copy(d, s)
# else
# if defined(__va_copy)
# define Perl_va_copy(s, d) __va_copy(d, s)
# else
# define Perl_va_copy(s, d) Copy(s, d, 1, va_list)
# endif
# endif
#endif
/* convenience debug macros */
#ifdef USE_ITHREADS
#define pTHX_FORMAT "Perl interpreter: 0x%p"
#define pTHX__FORMAT ", Perl interpreter: 0x%p"
#define pTHX_VALUE_ (void *)my_perl,
#define pTHX_VALUE (void *)my_perl
#define pTHX__VALUE_ ,(void *)my_perl,
#define pTHX__VALUE ,(void *)my_perl
#else
#define pTHX_FORMAT
#define pTHX__FORMAT
#define pTHX_VALUE_
#define pTHX_VALUE
#define pTHX__VALUE_
#define pTHX__VALUE
#endif /* USE_ITHREADS */
--- NEW FILE: hv.h ---
/* hv.h
*
* Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* typedefs to eliminate some typing */
typedef struct he HE;
typedef struct hek HEK;
/* entry in hash value chain */
struct he {
HE *hent_next; /* next entry in chain */
HEK *hent_hek; /* hash key */
SV *hent_val; /* scalar value that was hashed */
};
/* hash key -- defined separately for use as shared pointer */
struct hek {
U32 hek_hash; /* hash of key */
I32 hek_len; /* length of hash key */
char hek_key[1]; /* variable-length hash key */
/* the hash-key is \0-terminated */
/* after the \0 there is a byte for flags, such as whether the key
is UTF-8 */
};
/* hash structure: */
/* This structure must match the beginning of struct xpvmg in sv.h. */
struct xpvhv {
char * xhv_array; /* pointer to malloced string */
STRLEN xhv_fill; /* how full xhv_array currently is */
STRLEN xhv_max; /* subscript of last element of xhv_array */
IV xhv_keys; /* how many elements in the array */
NV xnv_nv; /* numeric value, if any */
#define xhv_placeholders xnv_nv
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
I32 xhv_riter; /* current root of iterator */
HE *xhv_eiter; /* current entry of iterator */
PMOP *xhv_pmroot; /* list of pm's for this package */
char *xhv_name; /* name, if a symbol table */
};
/* hash a key */
/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
* from requirements by Colin Plumb.
* (http://burtleburtle.net/bob/hash/doobs.html) */
/* The use of a temporary pointer and the casting games
* is needed to serve the dual purposes of
* (a) the hashed data being interpreted as "unsigned char" (new since 5.8,
* a "char" can be either signed or unsigned, depending on the compiler)
* (b) catering for old code that uses a "char"
*
* The "hash seed" feature was added in Perl 5.8.1 to perturb the results
* to avoid "algorithmic complexity attacks".
*
* If USE_HASH_SEED is defined, hash randomisation is done by default
* If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
* only if the environment variable PERL_HASH_SEED is set.
* For maximal control, one can define PERL_HASH_SEED.
* (see also perl.c:perl_parse()).
*/
#ifndef PERL_HASH_SEED
# if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
# define PERL_HASH_SEED PL_hash_seed
# else
# define PERL_HASH_SEED 0
# endif
#endif
#define PERL_HASH(hash,str,len) \
STMT_START { \
register const char *s_PeRlHaSh_tmp = str; \
register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
register I32 i_PeRlHaSh = len; \
register U32 hash_PeRlHaSh = PERL_HASH_SEED; \
while (i_PeRlHaSh--) { \
hash_PeRlHaSh += *s_PeRlHaSh++; \
hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
hash_PeRlHaSh ^= (hash_PeRlHaSh >> 6); \
} \
hash_PeRlHaSh += (hash_PeRlHaSh << 3); \
hash_PeRlHaSh ^= (hash_PeRlHaSh >> 11); \
(hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
} STMT_END
/* Only hv.c and mod_perl should be doing this. */
#ifdef PERL_HASH_INTERNAL_ACCESS
#define PERL_HASH_INTERNAL(hash,str,len) \
STMT_START { \
register const char *s_PeRlHaSh_tmp = str; \
register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
register I32 i_PeRlHaSh = len; \
register U32 hash_PeRlHaSh = PL_rehash_seed; \
while (i_PeRlHaSh--) { \
hash_PeRlHaSh += *s_PeRlHaSh++; \
hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
hash_PeRlHaSh ^= (hash_PeRlHaSh >> 6); \
} \
hash_PeRlHaSh += (hash_PeRlHaSh << 3); \
hash_PeRlHaSh ^= (hash_PeRlHaSh >> 11); \
(hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
} STMT_END
#endif
/*
=head1 Hash Manipulation Functions
=for apidoc AmU||HEf_SVKEY
This flag, used in the length slot of hash entries and magic structures,
specifies the structure contains an C<SV*> pointer where a C<char*> pointer
is to be expected. (For information only--not to be used).
=head1 Handy Values
=for apidoc AmU||Nullhv
Null HV pointer.
=head1 Hash Manipulation Functions
=for apidoc Am|char*|HvNAME|HV* stash
Returns the package name of a stash, or NULL if C<stash> isn't a stash.
See C<SvSTASH>, C<CvSTASH>.
=for apidoc Am|void*|HeKEY|HE* he
Returns the actual pointer stored in the key slot of the hash entry. The
pointer may be either C<char*> or C<SV*>, depending on the value of
C<HeKLEN()>. Can be assigned to. The C<HePV()> or C<HeSVKEY()> macros are
usually preferable for finding the value of a key.
=for apidoc Am|STRLEN|HeKLEN|HE* he
If this is negative, and amounts to C<HEf_SVKEY>, it indicates the entry
holds an C<SV*> key. Otherwise, holds the actual length of the key. Can
be assigned to. The C<HePV()> macro is usually preferable for finding key
lengths.
=for apidoc Am|SV*|HeVAL|HE* he
Returns the value slot (type C<SV*>) stored in the hash entry.
=for apidoc Am|U32|HeHASH|HE* he
Returns the computed hash stored in the hash entry.
=for apidoc Am|char*|HePV|HE* he|STRLEN len
Returns the key slot of the hash entry as a C<char*> value, doing any
necessary dereferencing of possibly C<SV*> keys. The length of the string
is placed in C<len> (this is a macro, so do I<not> use C<&len>). If you do
not care about what the length of the key is, you may use the global
variable C<PL_na>, though this is rather less efficient than using a local
variable. Remember though, that hash keys in perl are free to contain
embedded nulls, so using C<strlen()> or similar is not a good way to find
the length of hash keys. This is very similar to the C<SvPV()> macro
described elsewhere in this document.
=for apidoc Am|SV*|HeSVKEY|HE* he
Returns the key as an C<SV*>, or C<Nullsv> if the hash entry does not
contain an C<SV*> key.
=for apidoc Am|SV*|HeSVKEY_force|HE* he
Returns the key as an C<SV*>. Will create and return a temporary mortal
C<SV*> if the hash entry contains only a C<char*> key.
=for apidoc Am|SV*|HeSVKEY_set|HE* he|SV* sv
Sets the key to a given C<SV*>, taking care to set the appropriate flags to
indicate the presence of an C<SV*> key, and returns the same
C<SV*>.
=cut
*/
/* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */
#define HEf_SVKEY -2 /* hent_key is an SV* */
#define Nullhv Null(HV*)
#define HvARRAY(hv) (*(HE***)&((XPVHV*) SvANY(hv))->xhv_array)
#define HvFILL(hv) ((XPVHV*) SvANY(hv))->xhv_fill
#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max
#define HvRITER(hv) ((XPVHV*) SvANY(hv))->xhv_riter
#define HvRITER_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_riter)
#define HvRITER_set(hv,r) (HvRITER(hv) = (r))
#define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter
#define HvEITER_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_eiter)
#define HvEITER_set(hv,e) (HvEITER(hv) = (e))
#define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot
#define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name
/* FIXME - all of these should use a UTF8 aware API, which should also involve
getting the length. */
#define HvNAME_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_name)
#define hv_name_set(hv,name,length,flags) \
(HvNAME((hv)) = (name) ? savepvn(name, length) : 0)
/* the number of keys (including any placeholers) */
#define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys)
/* The number of placeholders in the enumerated-keys hash */
#define XHvPLACEHOLDERS(xhv) ((xhv)->xhv_placeholders)
/* the number of keys that exist() (i.e. excluding placeholders) */
#define XHvUSEDKEYS(xhv) (XHvTOTALKEYS(xhv) - (IV)XHvPLACEHOLDERS(xhv))
/*
* HvKEYS gets the number of keys that actually exist(), and is provided
* for backwards compatibility with old XS code. The core uses HvUSEDKEYS
* (keys, excluding placeholdes) and HvTOTALKEYS (including placeholders)
*/
#define HvKEYS(hv) XHvUSEDKEYS((XPVHV*) SvANY(hv))
#define HvUSEDKEYS(hv) XHvUSEDKEYS((XPVHV*) SvANY(hv))
#define HvTOTALKEYS(hv) XHvTOTALKEYS((XPVHV*) SvANY(hv))
#define HvPLACEHOLDERS(hv) (XHvPLACEHOLDERS((XPVHV*) SvANY(hv)))
#define HvPLACEHOLDERS_get(hv) (0 + XHvPLACEHOLDERS((XPVHV*) SvANY(hv)))
#define HvPLACEHOLDERS_set(hv, p) \
(XHvPLACEHOLDERS((XPVHV*) SvANY(hv)) = (p))
#define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS)
#define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS)
#define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS)
/* This is an optimisation flag. It won't be set if all hash keys have a 0
* flag. Currently the only flags relate to utf8.
* Hence it won't be set if all keys are 8 bit only. It will be set if any key
* is utf8 (including 8 bit keys that were entered as utf8, and need upgrading
* when retrieved during iteration. It may still be set when there are no longer
* any utf8 keys.
* See HVhek_ENABLEHVKFLAGS for the trigger.
*/
#define HvHASKFLAGS(hv) (SvFLAGS(hv) & SVphv_HASKFLAGS)
#define HvHASKFLAGS_on(hv) (SvFLAGS(hv) |= SVphv_HASKFLAGS)
#define HvHASKFLAGS_off(hv) (SvFLAGS(hv) &= ~SVphv_HASKFLAGS)
#define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL)
#define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL)
#define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL)
#define HvREHASH(hv) (SvFLAGS(hv) & SVphv_REHASH)
#define HvREHASH_on(hv) (SvFLAGS(hv) |= SVphv_REHASH)
#define HvREHASH_off(hv) (SvFLAGS(hv) &= ~SVphv_REHASH)
/* Maybe amagical: */
/* #define HV_AMAGICmb(hv) (SvFLAGS(hv) & (SVpgv_badAM | SVpgv_AM)) */
#define HV_AMAGIC(hv) (SvFLAGS(hv) & SVpgv_AM)
#define HV_AMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_AM)
#define HV_AMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_AM)
/*
#define HV_AMAGICbad(hv) (SvFLAGS(hv) & SVpgv_badAM)
#define HV_badAMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_badAM)
#define HV_badAMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_badAM)
*/
#define Nullhe Null(HE*)
#define HeNEXT(he) (he)->hent_next
#define HeKEY_hek(he) (he)->hent_hek
#define HeKEY(he) HEK_KEY(HeKEY_hek(he))
#define HeKEY_sv(he) (*(SV**)HeKEY(he))
#define HeKLEN(he) HEK_LEN(HeKEY_hek(he))
#define HeKUTF8(he) HEK_UTF8(HeKEY_hek(he))
#define HeKWASUTF8(he) HEK_WASUTF8(HeKEY_hek(he))
#define HeKREHASH(he) HEK_REHASH(HeKEY_hek(he))
#define HeKLEN_UTF8(he) (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he))
#define HeKFLAGS(he) HEK_FLAGS(HeKEY_hek(he))
#define HeVAL(he) (he)->hent_val
#define HeHASH(he) HEK_HASH(HeKEY_hek(he))
#define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \
SvPV(HeKEY_sv(he),lp) : \
(((lp = HeKLEN(he)) >= 0) ? \
HeKEY(he) : Nullch))
#define HeSVKEY(he) ((HeKEY(he) && \
HeKLEN(he) == HEf_SVKEY) ? \
HeKEY_sv(he) : Nullsv)
#define HeSVKEY_force(he) (HeKEY(he) ? \
((HeKLEN(he) == HEf_SVKEY) ? \
HeKEY_sv(he) : \
sv_2mortal(newSVpvn(HeKEY(he), \
HeKLEN(he)))) : \
&PL_sv_undef)
#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv))
#define Nullhek Null(HEK*)
#define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0])
#define HEK_HASH(hek) (hek)->hek_hash
#define HEK_LEN(hek) (hek)->hek_len
#define HEK_KEY(hek) (hek)->hek_key
#define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1))
#define HVhek_UTF8 0x01 /* Key is utf8 encoded. */
#define HVhek_WASUTF8 0x02 /* Key is bytes here, but was supplied as utf8. */
#define HVhek_REHASH 0x04 /* This key is in an hv using a custom HASH . */
#define HVhek_FREEKEY 0x100 /* Internal flag to say key is malloc()ed. */
#define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder.
* (may change, but Storable is a core module) */
#define HVhek_MASK 0xFF
/* Which flags enable HvHASKFLAGS? Somewhat a hack on a hack, as
HVhek_REHASH is only needed because the rehash flag has to be duplicated
into all keys as hv_iternext has no access to the hash flags. At this
point Storable's tests get upset, because sometimes hashes are "keyed"
and sometimes not, depending on the order of data insertion, and whether
it triggered rehashing. So currently HVhek_REHAS is exempt.
*/
#define HVhek_ENABLEHVKFLAGS (HVhek_MASK - HVhek_REHASH)
#define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8)
#define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8)
#define HEK_UTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_UTF8)
#define HEK_WASUTF8(hek) (HEK_FLAGS(hek) & HVhek_WASUTF8)
#define HEK_WASUTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_WASUTF8)
#define HEK_WASUTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_WASUTF8)
#define HEK_REHASH(hek) (HEK_FLAGS(hek) & HVhek_REHASH)
#define HEK_REHASH_on(hek) (HEK_FLAGS(hek) |= HVhek_REHASH)
/* calculate HV array allocation */
#ifndef PERL_USE_LARGE_HV_ALLOC
/* Default to allocating the correct size - default to assuming that malloc()
is not broken and is efficient at allocating blocks sized at powers-of-two.
*/
# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*))
#else
# define MALLOC_OVERHEAD 16
# define PERL_HV_ARRAY_ALLOC_BYTES(size) \
(((size) < 64) \
? (size) * sizeof(HE*) \
: (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD)
#endif
/* Flags for hv_iternext_flags. */
#define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */
/* available as a function in hv.c */
#define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash))
#define sharepvn(sv, len, hash) Perl_sharepvn(sv, len, hash)
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: genpacksizetables.pl ---
#!/usr/bin/perl -w
# I'm assuming that you're running this on some kind of ASCII system, but
# it will generate EDCDIC too. (TODO)
use strict;
use Encode;
my @lines = grep {!/^#/} <DATA>;
sub addline {
my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size,
$condition) = @_;
my $line = "/* $letter */ $size";
$line .= " | PACK_SIZE_SPARE" if $spare;
$line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
$line .= ",";
# And then the hack
$line = [$condition, $line] if $condition;
$arrays->{$arrayname}->[ord $chrmap->{$letter}] = $line;
# print ord $chrmap->{$letter}, " $line\n";
}
sub output_tables {
my %arrays;
my $chrmap = shift;
foreach (@_) {
my ($letter, $shriek, $spare, $nocsum, $size, $condition)
= /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/;
die "Can't parse '$_'" unless $size;
if (defined $condition) {
$condition = join " && ", map {"defined($_)"} split ' ', $condition;
}
unless ($size =~ s/^=//) {
$size = "sizeof($size)";
}
addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
$spare, $nocsum, $size, $condition);
}
my %earliest;
foreach my $arrayname (sort keys %arrays) {
my $array = $arrays{$arrayname};
die "No defined entries in $arrayname" unless $array->[$#$array];
# Find the first used entry
my $earliest = 0;
$earliest++ while (!$array->[$earliest]);
# Remove all the empty elements.
splice @$array, 0, $earliest;
print "unsigned char size_${arrayname}[", scalar @$array, "] = {\n";
my @lines;
foreach (@$array) {
# Remove the assumption here that the last entry isn't conditonal
if (ref $_) {
push @lines,
["#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif"];
} else {
push @lines, $_ ? " $_" : " 0,";
}
}
# remove the last, annoying, comma
my $last = $lines[$#lines];
my $got;
foreach (ref $last ? @$last : $last) {
$got += s/,$//;
}
die "Last entry had no commas" unless $got;
print map {"$_\n"} ref $_ ? @$_ : $_ foreach @lines;
print "};\n";
$earliest{$arrayname} = $earliest;
}
print "struct packsize_t packsize[2] = {\n";
my @lines;
foreach (qw(normal shrieking)) {
my $array = $arrays{$_};
push @lines, " {size_$_, $earliest{$_}, " . (scalar @$array) . "},";
}
# remove the last, annoying, comma
chop $lines[$#lines];
print "$_\n" foreach @lines;
print "};\n";
}
my %asciimap = (map {chr $_, chr $_} 0..255);
my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255);
print <<'EOC';
#if 'J'-'I' == 1
/* ASCII */
EOC
output_tables (\%asciimap, @lines);
print <<'EOC';
#else
/* EBCDIC (or bust) */
EOC
output_tables (\%ebcdicmap, @lines);
print "#endif\n";
__DATA__
#Symbol spare nocsum size
c char
C unsigned char
U char
s! short
s =SIZE16
S! unsigned short
v =SIZE16
n =SIZE16
S =SIZE16
v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
i int
i! int
I unsigned int
I! unsigned int
j =IVSIZE
J =UVSIZE
l! long
l =SIZE32
L! unsigned long
V =SIZE32
N =SIZE32
V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
L =SIZE32
p * char *
w * char
q Quad_t HAS_QUAD
Q Uquad_t HAS_QUAD
f float
d double
F =NVSIZE
D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE
--- NEW FILE: README.ko ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
This file is in Korean encoded in EUC-KR.
ÀÌ ¹®¼¸¦ perldocÀ» ½á¼ º¸Áö ¾Ê°í Á÷Á¢ º¸´Â °æ¿ì¿¡´Â °¢ ºÎºÐÀÇ
¿ªÇÒÀ» Ç¥½ÃÇϱâ À§ÇØ ¾²ÀÎ =head, =item, 'L' µîÀº ¹«½ÃÇϽʽÿÀ.
ÀÌ ¹®¼´Â µû·Î perldocÀ» ¾²Áö ¾Ê°í º¸´õ¶óµµ Àдµ¥ º° ÁöÀåÀÌ
¾ø´Â POD Çü½ÄÀ¸·Î Â¥¿© ÀÖ½À´Ï´Ù. ´õ ÀÚ¼¼ÇÑ °ÍÀº perlpod
¸Å´º¾óÀ» Âü°íÇϽʽÿÀ.
=head1 NAME
perlko - Perl°ú Çѱ¹¾î ÀÎÄÚµù
=head1 DESCRIPTION
PerlÀÇ ¼¼°è¿¡ ¿À½Å °ÍÀ» ȯ¿µÇÕ´Ï´Ù !
PerlÀº 5.8.0ÆǺÎÅÍ À¯´ÏÄÚµå/ISO 10646¿¡ ´ëÇÑ ±¤¹üÀ§ÇÑ Áö¿øÀ» ÇÕ´Ï´Ù.
À¯´ÏÄÚµå Áö¿øÀÇ ÀÏȯÀ¸·Î ÇÑÁßÀÏÀ» ºñ·ÔÇÑ ¼¼°è °¢±¹¿¡¼
À¯´ÏÄÚµå ÀÌÀü¿¡ ¾²°í ÀÖ¾ú°í Áö±Ýµµ ³Î¸® ¾²ÀÌ°í ÀÖ´Â ¼ö¸¹Àº ÀÎÄÚµùÀ»
Áö¿øÇÕ´Ï´Ù. À¯´ÏÄÚµå´Â Àü ¼¼°è¿¡¼ ¾²ÀÌ´Â ¸ðµç ¾ð¾î¸¦ À§ÇÑ Ç¥±â ü°è -
À¯·´ÀÇ ¶óƾ ¾ËÆĺª, Å°¸± ¾ËÆĺª, ±×¸®½º ¾ËÆĺª, Àεµ¿Í µ¿³² ¾Æ½Ã¾ÆÀÇ
ºê¶ó¹Ì °è¿ ½ºÅ©¸³Æ®, ¾Æ¶ø ¹®ÀÚ, È÷ºê¸® ¹®ÀÚ, ÇÑÁßÀÏÀÇ ÇÑÀÚ, Çѱ¹¾îÀÇ ÇѱÛ,
ÀϺ»¾îÀÇ °¡³ª, ºÏ¹Ì Àεð¾ÈÀÇ Ç¥±â ü°è µî-¸¦ ¼ö¿ëÇÏ´Â °ÍÀ» ¸ñÇ¥·Î ÇÏ°í
Àֱ⠶§¹®¿¡ ±âÁ¸¿¡ ¾²ÀÌ´ø °¢ ¾ð¾î ¹× ±¹°¡ ±×¸®°í ¿î¿µ ü°è¿¡ °íÀ¯ÇÑ
¹®ÀÚ ÁýÇÕ°ú ÀÎÄÚµù¿¡ ¾µ ¼ö ÀÖ´Â ¸ðµç ±ÛÀÚ´Â ¹°·ÐÀÌ°í ±âÁ¸ ¹®ÀÚ ÁýÇÕ¿¡¼
Áö¿øÇÏ°í ÀÖÁö ¾Ê´ø ¾ÆÁÖ ¸¹Àº ±ÛÀÚ¸¦ Æ÷ÇÔÇÏ°í ÀÖ½À´Ï´Ù.
PerlÀº ³»ºÎÀûÀ¸·Î À¯´ÏÄڵ带 ¹®ÀÚ Ç¥ÇöÀ» À§ÇØ »ç¿ëÇÕ´Ï´Ù. º¸´Ù ±¸Ã¼ÀûÀ¸·Î
¸»Çϸé Perl ½ºÅ©¸³Æ® ¾È¿¡¼ UTF-8 ¹®ÀÚ¿À» ¾µ ¼ö ÀÖ°í,
°¢Á¾ ÇÔ¼ö¿Í ¿¬»êÀÚ(¿¹¸¦ µé¾î, Á¤±Ô½Ä, index, substr)°¡ ¹ÙÀÌÆ® ´ÜÀ§
´ë½Å À¯´ÏÄÚµå ±ÛÀÚ ´ÜÀ§·Î µ¿ÀÛÇÕ´Ï´Ù. (´õ ÀÚ¼¼ÇÑ °ÍÀº
perlunicode ¸Å´º¾óÀ» Âü°íÇϽʽÿÀ.) À¯´ÏÄڵ尡 ³Î¸® º¸±ÞµÇ±â Àü¿¡
³Î¸® ¾²ÀÌ°í ÀÖ¾ú°í, ¿©ÀüÈ÷ ³Î¸® ¾²ÀÌ°í ÀÖ´Â °¢±¹/°¢ ¾ð¾îº° ÀÎÄÚµùÀ¸·Î
ÀÔÃâ·ÂÀ» ÇÏ°í À̵é ÀÎÄÚµùÀ¸·Î µÈ µ¥ÀÌÅÍ¿Í ¹®¼¸¦ ´Ù·ç´Â °ÍÀ» µ½±â À§ÇØ
'Encode'°¡ ¾²¿´½À´Ï´Ù. ¹«¾ùº¸´Ù 'Encode'¸¦ ½á¼ ¼ö¸¹Àº ÀÎÄÚµù »çÀÌÀÇ
º¯È¯À» ½±°Ô ÇÒ ¼ö ÀÖ½À´Ï´Ù.
'Encode'´Â ´ÙÀ½°ú °°Àº Çѱ¹¾î ÀÎÄÚµùÀ» Áö¿øÇÕ´Ï´Ù.
=over 4
=item euc-kr
US-ASCII¿Í KS X 1001À» °°ÀÌ ¾²´Â ¸ÖƼ¹ÙÀÌÆ® ÀÎÄÚµù (ÈçÈ÷ ¿Ï¼ºÇüÀ̶ó°í
ºÒ¸².) KS X 2901°ú RFC 1557 Âü°í.
=item cp949
MS-Windows 9x/ME¿¡¼ ¾²ÀÌ´Â È®Àå ¿Ï¼ºÇü. euc-kr¿¡ 8,822ÀÚÀÇ
ÇÑ±Û À½ÀýÀ» ´õÇÑ °ÍÀÓ. alias´Â uhc, windows-949, x-windows-949,
ks_c_5601-1987. ¸Ç ¸¶Áö¸· À̸§Àº ÀûÀýÇÏÁö ¾ÊÀº À̸§ÀÌÁö¸¸, Microsoft
Á¦Ç°¿¡¼ CP949ÀÇ Àǹ̷Π¾²ÀÌ°í ÀÖÀ½.
=item johab
KS X 1001:1998 ºÎ·Ï 3¿¡¼ ±ÔÁ¤ÇÑ Á¶ÇÕÇü. ¹®ÀÚ ·¹ÆÛÅ丮´Â cp949¿Í
¸¶Âù°¡Áö·Î US-ASCII¿Í KS X 1001¿¡ 8,822ÀÚÀÇ ÇÑ±Û À½ÀýÀ» ´õÇÑ °ÍÀÓ.
ÀÎÄÚµù ¹æ½ÄÀº ÀüÇô ´Ù¸§.
=item iso-2022-kr
RFC 1557¿¡¼ ±ÔÁ¤ÇÑ Çѱ¹¾î ÀÎÅÍ³Ý ¸ÞÀÏ ±³È¯¿ë ÀÎÄÚµùÀ¸·Î US-ASCII¿Í
KS X 1001À» ·¹ÆÛÅ丮·Î ÇÏ´Â Á¡¿¡¼ euc-kr°ú °°Áö¸¸ ÀÎÄÚµù ¹æ½ÄÀÌ ´Ù¸§.
1997-8³â °æ±îÁö ¾²¿´À¸³ª ´õ ÀÌ»ó ¸ÞÀÏ ±³È¯¿¡ ¾²ÀÌÁö ¾ÊÀ½.
=item ksc5601-raw
KS X 1001(KS C 5601)À» GL(Áï, MSB¸¦ 0À¸·Î ÇÑ °æ¿ì) ¿¡ ³õ¾ÒÀ» ¶§ÀÇ
ÀÎÄÚµù. US-ASCII¿Í °áÇÕÇÏÁö ¾Ê°í ´Üµ¶À¸·Î ¾²ÀÌ´Â ÀÏÀº X11 µî¿¡¼ ±Û²Ã
ÀÎÄÚµù (ksc5601.1987-0. '0'Àº GLÀ» ÀǹÌÇÔ.)À¸·Î ¾²ÀÌ´Â °ÍÀ» Á¦¿ÜÇÏ°í´Â
°ÅÀÇ ¾øÀ½. KS C 5601Àº 1997³â KS X 1001·Î À̸§À» ¹Ù²Ù¾úÀ½. 1998³â¿¡´Â µÎ
±ÛÀÚ (À¯·ÎÈ ºÎÈ£¿Í µî·Ï »óÇ¥ ºÎÈ£)°¡ ´õÇØÁ³À½.
=back
¸î °¡Áö »ç¿ë ¿¹Á¦¸¦ ¾Æ·¡¿¡ º¸ÀÔ´Ï´Ù.
¿¹¸¦ µé¾î, euc-kr ÀÎÄÚµùÀ¸·Î µÈ ÆÄÀÏÀ» UTF-8·Î º¯È¯ÇÏ·Á¸é ´ÙÀ½°ú
°°ÀÌ ÇÏ¸é µË´Ï´Ù.
perl -Mencoding=euc-kr,STDOUT,utf8 -pe1 < file.euckr > file.utf8
¿ªº¯È¯Àº ´ÙÀ½°ú °°ÀÌ ÇÒ ¼ö ÀÖ½À´Ï´Ù.
perl -Mencoding=utf8,STDOUT,euc-kr -pe1 < file.utf8 > file.euckr
ÀÌ·± º¯È¯À» Á»´õ Æí¸®ÇÏ°Ô ÇÒ ¼ö ÀÖµµ·Ï Encode ¸ðµâÀ» ½á¼
¼ø¼öÇÏ°Ô Perl·Î¸¸ ¾²ÀÎ piconv°¡ Perl¿¡ µé¾î ÀÖ½À´Ï´Ù.
±× À̸§¿¡¼ ¾Ë ¼ö ÀÖµíÀÌ piconv´Â Unix¿¡ ÀÖ´Â iconv¸¦
¸ðµ¨·Î ÇÑ °ÍÀÔ´Ï´Ù. ±× »ç¿ë¹ýÀº ¾Æ·¡¿Í °°½À´Ï´Ù.
piconv -f euc-kr -t utf8 < file.euckr > file.utf8
piconv -f utf8 -t euc-kr < file.utf8 > file.euckr
¶Ç, 'PerlIO::encoding' ¸ðµâÀ» ½á¼ Çѱ¹¾î ÀÎÄÚµùÀ» ¾²¸é¼ ±ÛÀÚ ´ÜÀ§
(¹ÙÀÌÆ® ´ÜÀ§°¡ ¾Æ´Ï¶ó) 󸮸¦ ½±°Ô ÇÒ ¼ö ÀÖ½À´Ï´Ù.
#!/path/to/perl
use encoding 'euc-kr', STDIN => 'euc-kr',
STDOUT-> 'euc-kr', STDERR=>'euc-kr';
print length("°¡³ª"); # 2 (Å« µû¿ÈÇ¥´Â ±ÛÀÚ ´ÜÀ§ 󸮸¦ Áö½Ã)
print length('°¡³ª'); # 4 (ÀÛÀº µû¿ÈÇ¥´Â ¹ÙÀÌÆ® ´ÜÀ§ 󸮸¦ Áö½Ã)
print index("ÇÑ°, ´ëµ¿°", "¿°"); # -1 ('¿°'ÀÌ ¾øÀ½)
print index('ÇÑ°, ´ëµ¿°', '¿°'); # 7 (8¹ø°¿Í 9¹ø° ¹ÙÀÌÆ®°¡ '¿°'ÀÇ
Äڵ尪°ú ÀÏÄ¡ÇÔ.)
=head2 ´õ ÀÚ¼¼È÷ ¾Ë°í ½ÍÀ¸¸é...
PerlÀ» ¼³Ä¡ÇÏ¸é ´ë´ÜÈ÷ ÀÚ¼¼ÇÑ ¹®¼°¡ °°ÀÌ µû¶ó ¿À¸ç, ÀÌ ¹®¼¸¦ ÅëÇØ
Perl Àü¹Ý »Ó ¾Æ´Ï¶ó À¯´ÏÄÚµå Áö¿ø, EncodeÀÇ »ç¿ë¹ý µî¿¡ ¸¹Àº °ÍÀ»
¹è¿ï ¼ö ÀÖ½À´Ï´Ù. ¾ÆÁ÷ ÀÌ ¹®¼´Â ÇöÀç ¸ðµÎ ¿µ¾î·Î ¾²¿© ÀÖ½À´Ï´Ù.
=head2 Perl °ü·Ã ÀÚ·á
À§¿¡¼ ¾ð±ÞÇÑ ¹®¼ ¿Ü¿¡µµ ´ÙÀ½°ú °°Àº ÀÚ·á°¡ ÀÖ½À´Ï´Ù. ÀÌ ¸ñ·ÏÀº °áÄÚ
¿ÏÀüÇÑ °ÍÀÌ ¾Æ´Ï°í ÀϺΠ´ëÇ¥ÀûÀÎ °Í¸¸ ¸ðÀº °ÍÀÔ´Ï´Ù.
=over 4
=item L<http://www.perl.com/>
O'ReillyÀÇ Perl À¥ ÆäÀÌÁö
=item L<http://www.cpan.org/>
Comprehensive Perl Archive Network
=item L<http://lists.perl.org/>
Perl ¸ÞÀϸµ ¸®½ºÆ®. ¸¹Àº ¸®½ºÆ® °¡¿îµ¥
perl-unicode¿¡¼ 'Encode'¿¡ ´ëÇØ ³íÀÇÇÔ.
=back
=head2 PerlÀ» ´õ ±í°Ô °øºÎÇϴµ¥ µµ¿òÀ» ÁÙ ¼ö ÀÖ´Â Çѱ¹¾î °ü·Ã »çÀÌÆ®
=over 4
=item L<http://www.perl.or.kr/>
Perl Çѱ¹ »ç¿ëÀÚ ¸ðÀÓ
=item L<news:han.comp.lang.perl/>
Çѱ¹¾î Perl ´º½º ±×·ì
=item L<http://seoul.pm.org/>
Perl ¸Á°Å½º (¼¿ï)
=item L<http://www.perlmania.or.kr/>
Home for Korean Perlmanias
=item L<http://www.oreilly.co.kr/perl/>
O'Reilly¿¡¼ ³ª¿Â Çѱ¹¾î Perl ¼Àû ¸ñ·Ï
=item L<http://www.perlschool.net/>
Perl ±âÃÊ °Á ¹× ¼Ò½º, ÃÖ±Ù µ¿Çâ, °ü·Ã ÇØ¿Ü »çÀÌÆ® ¸µÅ©
=item L<http://www.perl.co.kr>
Perl¿¡ °ü·ÃµÈ CGI, DB, ¿¬µ¿ µî¿¡ ´ëÇÑ Á¤º¸ ¹× ´º½º Á¦°ø
=back
=head2 À¯´ÏÄÚµå ¹× Çѱ¹¾î ÀÎÄÚµù °ü·Ã ÀÚ·á
=over 4
=item L<http://www.unicode.org/>
À¯´ÏÄÚµå ÄÁ¼Ò½Ã¾ö.
=item L<http://std.dkuug.dk/JTC1/SC2/WG2>
±âº»ÀûÀ¸·Î Unicode¿Í °°Àº ISO Ç¥ÁØÀÎ ISO/IEC 10646 UCS(Universal
Character Set)À» ¸¸µå´Â ISO/IEC JTC1/SC2/WG2ÀÇ À¥ ÆäÀÌÁö.
=item L<http://jshin.net/faq/qa8.html>
Çѱ¹¾î ¹®ÀÚ ÁýÇÕ ¹× ÀÎÄÚµù¿¡ ´ëÇÑ ¾È³».
=item L<http://www.cl.cam.ac.uk/~mgk25/unicode.html>
À¯´Ð½º/¸®´ª½º¿¡¼ À¯´ÏÄÚµå¿Í UTF-8 »ç¿ë¿¡ ´ëÇÑ ¹®´äÁý(FAQ)
=item L<http://kldp.org/Translations/html/UTF8-Unicode-KLDP/UTF8-Unicode-KLDP.html>
À¯´Ð½º/¸®´ª½º¿¡¼ À¯´ÏÄÚµå¿Í UTF-8 »ç¿ë¿¡ ´ëÇÑ ¹®´äÁý(FAQ)ÀÇ Çѱ¹¾î ¹ø¿ª
=back
=head1 SEE ALSO
L<Encode>, L<Encode::KR>, L<encoding>, L<perluniintro>, L<perlunicode>
=head1 AUTHORS
Jarkko Hietaniemi E<lt>jhi at iki.fiE<gt>
½ÅÁ¤½Ä E<lt>jshin at mailaps.orgE<gt>
=cut
--- NEW FILE: av.h ---
/* av.h
*
* Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
struct xpvav {
char* xav_array; /* pointer to first array element */
SSize_t xav_fill; /* Index of last element present */
SSize_t xav_max; /* max index for which array has space */
IV xof_off; /* ptr is incremented by offset */
NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
SV** xav_alloc; /* pointer to beginning of C array of SVs */
SV* xav_arylen;
U8 xav_flags;
};
/* AVf_REAL is set for all AVs whose xav_array contents are refcounted.
* Some things like "@_" and the scratchpad list do not set this, to
* indicate that they are cheating (for efficiency) by not refcounting
* the AV's contents.
*
* AVf_REIFY is only meaningful on such "fake" AVs (i.e. where AVf_REAL
* is not set). It indicates that the fake AV is capable of becoming
* real if the array needs to be modified in some way. Functions that
* modify fake AVs check both flags to call av_reify() as appropriate.
*
* Note that the Perl stack and @DB::args have neither flag set. (Thus,
* items that go on the stack are never refcounted.)
*
* These internal details are subject to change any time. AV
* manipulations external to perl should not care about any of this.
* GSAR 1999-09-10
*/
#define AVf_REAL 1 /* free old entries */
#define AVf_REIFY 2 /* can become real */
/* XXX this is not used anywhere */
#define AVf_REUSED 4 /* got undeffed--don't turn old memory into SVs now */
/*
=head1 Handy Values
=for apidoc AmU||Nullav
Null AV pointer.
=head1 Array Manipulation Functions
=for apidoc Am|int|AvFILL|AV* av
Same as C<av_len()>. Deprecated, use C<av_len()> instead.
=cut
*/
#define Nullav Null(AV*)
#define AvARRAY(av) ((SV**)((XPVAV*) SvANY(av))->xav_array)
#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc
#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max
#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill
#define AvARYLEN(av) ((XPVAV*) SvANY(av))->xav_arylen
#define AvFLAGS(av) ((XPVAV*) SvANY(av))->xav_flags
#define AvREAL(av) (AvFLAGS(av) & AVf_REAL)
#define AvREAL_on(av) (AvFLAGS(av) |= AVf_REAL)
#define AvREAL_off(av) (AvFLAGS(av) &= ~AVf_REAL)
#define AvREIFY(av) (AvFLAGS(av) & AVf_REIFY)
#define AvREIFY_on(av) (AvFLAGS(av) |= AVf_REIFY)
#define AvREIFY_off(av) (AvFLAGS(av) &= ~AVf_REIFY)
#define AvREUSED(av) (AvFLAGS(av) & AVf_REUSED)
#define AvREUSED_on(av) (AvFLAGS(av) |= AVf_REUSED)
#define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
#define AvREALISH(av) (AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
#define AvFILL(av) ((SvRMAGICAL((SV *) (av))) \
? mg_size((SV *) av) : AvFILLp(av))
#define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES"
--- NEW FILE: utils.lst ---
pod/pod2html
pod/pod2latex
pod/pod2man
pod/pod2text
pod/pod2usage
pod/podchecker
pod/podselect
utils/c2ph # link = utils/pstruct
utils/cpan
utils/dprofpp
utils/enc2xs
utils/h2ph
utils/h2xs
utils/instmodsh
utils/libnetcfg
utils/perlbug
utils/perlcc
utils/perldoc # pod = pod/perldoc.pod
utils/perlivp
utils/piconv
utils/pl2pm
utils/prove
utils/splain
utils/xsubpp
x2p/a2p # pod = x2p/a2p.pod
x2p/find2perl
x2p/s2p # link = x2p/psed
--- NEW FILE: hv.c ---
/* hv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "I sit beside the fire and think of all that I have seen." --Bilbo
*/
/*
=head1 Hash Manipulation Functions
A HV structure represents a Perl hash. It consists mainly of an array
of pointers, each of which points to a linked list of HE structures. The
[...2091 lines suppressed...]
}
++HeVAL(entry); /* use value slot as REFCNT */
UNLOCK_STRTAB_MUTEX;
if (flags & HVhek_FREEKEY)
Safefree(str);
return HeKEY_hek(entry);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: Copying ---
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- NEW FILE: dump.c ---
/* dump.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
* it has not been hard for me to read your mind and memory.'"
*/
/* This file contains utility routines to dump the contents of SV and OP
* structures, as used by command-line options like -Dt and -Dx, and
* by Devel::Peek.
*
[...1531 lines suppressed...]
unsigned i;
if (!PL_profiledata)
return;
for (i = 0; i < MAXO; i++) {
if (PL_profiledata[i])
PerlIO_printf(Perl_debug_log,
"%5lu %s\n", (unsigned long)PL_profiledata[i],
PL_op_name[i]);
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.ce ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
perlce - Perl for WinCE
=head1 DESCRIPTION
This file gives the instructions for building Perl5.8 and above for
WinCE. Please read and understand the terms under which this
software is distributed.
=head1 BUILD
This section describes the steps to be performed to build PerlCE.
You may find additional and newer information about building perl
for WinCE using following URL:
http://perlce.sourceforge.net
There should also be pre-built binaries there.
Don't be confused by large size of downloaded distribution or constructed
binaries: entire distribution could be large for WinCE ideology, but
you may strip it at your wish and use only required parts.
=head2 Tools & SDK
For compiling, you need following:
=over 4
=item * Microsoft Embedded Visual Tools
=item * Microsoft Visual C++
=item * Rainer Keuchel's celib-sources
=item * Rainer Keuchel's console-sources
=back
Needed source files can be downloaded via:
www.rainer-keuchel.de/wince/dirlist.html
=head2 Make
Please pay attention that starting from 5.8.0 miniperl *is* built
and it facilitates in further building process. This means that
in addition to compiler installation for mobile device you also need
to have Microsoft Visual C++ installed as well.
On the bright side, you do not need to edit any files from ./win32
subdirectory. Normally you only need to edit ./wince/compile.bat
to reflect your system and run it.
File ./wince/compile.bat is actually a wrapper to call
nmake -f makefile.ce with appropriate parameters and it accepts extra
parameters and forwards them to "nmake" command as additional
arguments. You should pass target this way.
To prepare distribution you need to do following:
=over 4
=item * go to ./wince subdirectory
=item * edit file compile.bat
=item * run
compile.bat
=item * run
compile.bat dist
=back
makefile.ce has CROSS_NAME macro, and it is used further to refer to
your cross-compilation scheme. You could assign a name to it, but this
is not necessary, because by default it is assigned after your machine
configuration name, such as "wince-sh3-hpc-wce211", and this is enough
to distinguish different builds at the same time. This option could be
handy for several different builds on same platform to perform, say,
threaded build. In a following example we assume that all required
environment variables are set properly for C cross-compiler (a special
*.bat file could fit perfectly to this purpose) and your compile.bat
has proper "MACHINE" parameter set, to, say, "wince-mips-pocket-wce300".
compile.bat
compile.bat dist
compile.bat CROSS_NAME=mips-wce300-thr "USE_ITHREADS=define" "USE_IMP_SYS=define" "USE_MULTI=define"
compile.bat CROSS_NAME=mips-wce300-thr "USE_ITHREADS=define" "USE_IMP_SYS=define" "USE_MULTI=define" dist
If all goes okay and no errors during a build, you'll get two independent
distributions: "wince-mips-pocket-wce300" and "mips-wce300-thr".
Target 'dist' prepares distribution file set. Target 'zipdist' performs
same as 'dist' but additionally compresses distribution files into zip
archive.
NOTE: during a build there could be created a number (or one) of Config.pm
for cross-compilation ("foreign" Config.pm) and those are hidden inside
../xlib/$(CROSS_NAME) with other auxilary files, but, and this is important to
note, there should be *no* Config.pm for host miniperl.
If you'll get an error that perl could not find Config.pm somewhere in building
process this means something went wrong. Most probably you forgot to
specify a cross-compilation when invoking miniperl.exe to Makefile.PL
When building an extension for cross-compilation your command line should
look like
..\miniperl.exe -I..\lib -MCross=mips-wce300-thr Makefile.PL
or just
..\miniperl.exe -I..\lib -MCross Makefile.PL
to refer a cross-compilation that was created last time.
If you decided to build with fcrypt.c file, please refer to README.win32
file, as long as all legal considerations and steps to do are exactly same
in this case.
All questions related to building for WinCE devices could be asked in
perlce-users at lists.sourceforge.net mailing list.
=head1 ACKNOWLEDGEMENTS
The port for Win32 was used as a reference.
=head1 AUTHORS
Rainer Keuchel (keuchel at netwave.de)
Vadim Konovalov (vkonovalov at spb.lucent.com)
--- NEW FILE: perl_keyword.pl ---
# How to generate the logic of the lookup table Perl_keyword() in toke.c
use Devel::Tokenizer::C 0.05;
use strict;
use warnings;
my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY do delete defined
END else eval elsif exists for format foreach grep goto glob INIT
if last local m my map next no our pos print printf package
prototype q qr qq qw qx redo return require s scalar sort split
study sub tr tie tied use undef until untie unless while y);
# In 5.8.x there is no err
my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless
bind binmode CORE cmp chr cos chop close chdir chomp chmod chown
crypt chroot caller connect closedir continue die dump dbmopen
dbmclose eq eof exp exit exec each endgrent endpwent
endnetent endhostent endservent endprotoent fork fcntl flock
fileno formline getppid getpgrp getpwent getpwnam getpwuid
getpeername getprotoent getpriority getprotobyname
getprotobynumber gethostbyname gethostbyaddr gethostent
getnetbyname getnetbyaddr getnetent getservbyname getservbyport
getservent getsockname getsockopt getgrent getgrnam getgrgid
getlogin getc gt ge gmtime hex int index ioctl join keys kill lt
le lc log link lock lstat length listen lcfirst localtime mkdir
msgctl msgget msgrcv msgsnd ne not or ord oct open opendir pop
push pack pipe quotemeta ref read rand recv rmdir reset rename
rindex reverse readdir readlink readline readpipe rewinddir seek
send semop select semctl semget setpgrp seekdir setpwent setgrent
setnetent setsockopt sethostent setservent setpriority
setprotoent shift shmctl shmget shmread shmwrite shutdown sin
sleep socket socketpair sprintf splice sqrt srand stat substr
system symlink syscall sysopen sysread sysseek syswrite tell time
times telldir truncate uc utime umask unpack unlink unshift
ucfirst values vec warn wait write waitpid wantarray x xor);
my %pos = map { ($_ => 1) } @pos;
my $t = Devel::Tokenizer::C->new( TokenFunc => \&perl_keyword
, TokenString => 'name'
, StringLength => 'len'
, MergeSwitches => 1
);
$t->add_tokens(@pos, @neg, 'elseif');
my $switch = $t->generate(Indent => ' ');
print <<END;
/*
* The following code was generated by $0.
*/
I32
Perl_keyword (pTHX_ char *name, I32 len)
{
$switch
unknown:
return 0;
}
END
sub perl_keyword
{
my $k = shift;
my $sign = $pos{$k} ? '' : '-';
if ($k eq 'elseif') {
return <<END;
if(ckWARN_d(WARN_SYNTAX))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
END
}
return <<END;
return ${sign}KEY_$k;
END
}
--- NEW FILE: cflags.SH ---
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting cflags (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front. You may delete these comments.
rm -f cflags
$spitshell >cflags <<!GROK!THIS!
$startsh
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>cflags <<'!NO!SUBS!'
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
: syntax: cflags [optimize=XXX] [file[.suffix]]
: displays the compiler command line for file
case "X$1" in
Xoptimize=*|X"optimize=*")
eval "$1"
shift
;;
esac
also=': '
case $# in
1) also='echo 1>&2 " CCCMD = "'
esac
case $# in
0) set *.c; echo "The current C flags are:" ;;
esac
set `echo "$* " | sed -e 's/\.[oc] / /g' -e 's/\.obj / /g' -e "s/\\$obj_ext / /g"`
for file do
case "$#" in
1) ;;
*) echo $n " $file.c $c" ;;
esac
: allow variables like toke_cflags to be evaluated
if echo $file | grep -v / >/dev/null
then
eval 'eval ${'"${file}_cflags"'-""}'
fi
: or customize here
case "$file" in
DB_File) ;;
GDBM_File) ;;
NDBM_File) ;;
ODBM_File) ;;
POSIX) ;;
SDBM_File) ;;
av) ;;
byterun) ;;
deb) ;;
dl) ;;
doio) ;;
doop) ;;
dump) ;;
gv) ;;
hv) ;;
locale) ;;
main) ;;
malloc) ;;
mg) ;;
miniperlmain) ;;
numeric) ;;
op) ;;
perl) ;;
perlapi) ;;
perlmain) ;;
perly) ;;
pp) ;;
pp_ctl) ;;
pp_hot) ;;
pp_pack) ;;
pp_sys) ;;
regcomp) ;;
regexec) ;;
run) ;;
scope) ;;
sv) ;;
taint) ;;
toke) ;;
usersub) ;;
util) ;;
*) ;;
esac
# Add -Wall for the core modules iff gcc and not already -Wall
warn=''
case "$gccversion" in
'') ;;
Intel*) ;;
*) case "$ccflags" in
*-Wall*) ;;
*) warn="$warn -Wall" ;;
esac
case "$gccansipedantic" in
define)
case "$gccversion" in
[12]*) ;; # gcc versions 1 (gasp!) and 2 are not good for this.
*) case "$osname" in
# Add -ansi -pedantic only for known platforms.
aix|dec_osf|freebsd|hpux|irix|linux)
ansipedantic="-ansi -pedantic" ;;
solaris)
# Can't add -ansi for Solaris.
# Off_t/off_t is a struct in Solaris with largefiles, and with -ansi
# that struct cannot be compared with a flat integer, such as a STRLEN.
# The -ansi will also cause a lot of noise in Solaris because of:
# /usr/include/sys/resource.h:148: warning: `struct rlimit64' declared inside parameter list
ansipedantic="-pedantic" ;;
esac
for i in $ansipedantic
do
case "$ccflags" in
*$i*) ;;
*) warn="$warn $i" ;;
esac
done
case "$warn$ccflags" in
*-pedantic*) warn="$warn -DPERL_GCC_PEDANTIC" ;;
esac
;;
esac
;;
esac
;;
esac
: Can we perhaps use $ansi2knr here
echo "$cc -c -DPERL_CORE $ccflags $optimize $warn"
eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $warn"'
. $TOP/config.sh
done
!NO!SUBS!
chmod 755 cflags
$eunicefix cflags
--- NEW FILE: installman ---
#!./perl -w
BEGIN { @INC = qw(lib) }
use strict;
use Config;
use Getopt::Long;
use File::Find;
use File::Copy;
use File::Path qw(mkpath);
use ExtUtils::Packlist;
use Pod::Man;
use subs qw(unlink chmod rename link);
use vars qw($packlist);
if ($Config{d_umask}) {
umask(022); # umasks like 077 aren't that useful for installations
}
$ENV{SHELL} = 'sh' if $^O eq 'os2';
my $ver = $Config{version}; # Not used presently.
my $release = substr($],0,3); # Not used presently.
my $patchlevel = substr($],3,2);
die "Patchlevel of perl ($patchlevel)",
"and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
if $patchlevel != $Config{'PERL_VERSION'};
my $usage =
"Usage: installman --man1dir=/usr/wherever --man1ext=1
--man3dir=/usr/wherever --man3ext=3
--batchlimit=40
--notify --verbose --silent --help
Defaults are:
man1dir = $Config{'installman1dir'};
man1ext = $Config{'man1ext'};
man3dir = $Config{'installman3dir'};
man3ext = $Config{'man3ext'};
--notify (or -n) just lists commands that would be executed.
--verbose (or -V) report all progress.
--silent (or -S) be silent. Only report errors.\n";
my %opts;
GetOptions( \%opts,
qw( man1dir=s man1ext=s man3dir=s man3ext=s batchlimit=i
destdir:s notify n help silent S verbose V))
|| die $usage;
die $usage if $opts{help};
$opts{man1dir} = "$opts{destdir}$Config{'installman1dir'}"
unless defined($opts{man1dir});
$opts{man1ext} = $Config{'man1ext'}
unless defined($opts{man1ext});
$opts{man3dir} = "$opts{destdir}$Config{'installman3dir'}"
unless defined($opts{man3dir});
$opts{man3ext} = $Config{'man3ext'}
unless defined($opts{man3ext});
$opts{silent} ||= $opts{S};
$opts{notify} ||= $opts{n};
$opts{verbose} ||= $opts{V} || $opts{notify};
#Sanity checks
-x "./perl$Config{exe_ext}"
or warn "./perl$Config{exe_ext} not found! Have you run make?\n";
-d "$opts{destdir}$Config{'installprivlib'}"
|| warn "Perl library directory $Config{'installprivlib'} not found.
Have you run make install?. (Installing anyway.)\n";
-x "t/perl$Config{exe_ext}" || warn "WARNING: You've never run 'make test'!!!",
" (Installing anyway.)\n";
$packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.packlist");
# Install the main pod pages.
pod2man('pod', $opts{man1dir}, $opts{man1ext});
# Install the pods for library modules.
pod2man('lib', $opts{man3dir}, $opts{man3ext});
# Install the pods embedded in the installed scripts
my $has_man1dir = $opts{man1dir} ne '' && -d $opts{man1dir};
open UTILS, "utils.lst" or die "Can't open 'utils.lst': $!";
while (<UTILS>) {
next if /^#/;
chomp;
$_ = $1 if /#.*pod\s*=\s*(\S+)/;
my ($where, $what) = m|^(\S*)/(\S+)|;
pod2man($where, $opts{man1dir}, $opts{man1ext}, $what);
if ($has_man1dir) {
if (my ($where2, $what2) = m|#.*link\s*=\s*(\S+)/(\S+)|) {
my $old = "$opts{man1dir}/$what.$opts{man1ext}";
my $new = "$opts{man1dir}/$what2.$opts{man1ext}";
unlink($new);
link($old, $new);
my $xold = $old;
$xold =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
my $xnew = $new;
$xnew =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
$packlist->{$xnew} = { from => $xold, type => 'link' };
}
}
}
sub pod2man {
# @script is scripts names if we are installing manpages embedded
# in scripts, () otherwise
my($poddir, $mandir, $manext, @script) = @_;
if ($mandir eq ' ' or $mandir eq '') {
if (@script) {
warn "Skipping installation of $poddir/$_ man page.\n"
foreach @script;
} else {
warn "Skipping installation of $poddir man pages.\n";
}
return;
}
print "installing from $poddir\n" if $opts{verbose};
mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify}; # In File::Path
# Make a list of all the .pm and .pod files in the directory. We avoid
# chdir because we are running with @INC = '../lib', and modules may wish
# to dynamically require Carp::Heavy or other diagnostics warnings.
# Hash the names of files we find, keys are names relative to perl build
# dir ('.'), values are names relative to $poddir.
my %modpods;
if (@script) {
%modpods = (map {+"$poddir/$_", $_} @script);
}
else {
File::Find::find({no_chdir=>1,
wanted => sub {
# $_ is $File::Find::name when using no_chdir
if (-f $_ and /\.p(?:m|od)$/) {
my $fullname = $_;
s!^\Q$poddir\E/!!;
$modpods{$fullname} = $_;
}
}},
$poddir);
}
my @to_process;
foreach my $mod (sort keys %modpods) {
my $manpage = $modpods{$mod};
my $tmp;
# Skip .pm files that have corresponding .pod files, and Functions.pm.
next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp);
next if $mod =~ m:/t/:; # no pods from test directories
next if ($manpage eq 'Pod/Functions.pm'); #### Used only by pod itself
# Skip files without pod docs
my $has_pod;
if (open T, $mod)
{
local $_;
while (<T>)
{
++$has_pod and last if /^=(?:head\d+|item|pod)\b/;
}
close T;
}
unless ($has_pod)
{
warn "no documentation in $mod\n";
next;
}
# Convert name from File/Basename.pm to File::Basename.3 format,
# if necessary.
$manpage =~ s#\.p(m|od)$##;
if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') {
$manpage =~ s#/#.#g;
}
else {
$manpage =~ s#/#::#g;
}
$tmp = "${mandir}/${manpage}.tmp";
$manpage = "${mandir}/${manpage}.${manext}";
push @to_process, [$mod, $tmp, $manpage];
}
my $parser = Pod::Man->new( section => $manext,
official=> 1,
center => 'Perl Programmers Reference Guide'
);
foreach my $page (@to_process) {
my($pod, $tmp, $manpage) = @$page;
my $xmanpage = $manpage;
$xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
print " $xmanpage\n";
if (!$opts{notify} && $parser->parse_from_file($pod, $tmp)) {
if (-s $tmp) {
if (rename($tmp, $manpage)) {
$packlist->{$xmanpage} = { type => 'file' };
next;
}
}
unlink($tmp);
}
}
}
$packlist->write() unless $opts{notify};
print " Installation complete\n" if $opts{verbose};
exit 0;
###############################################################################
# Utility subroutines from installperl
sub unlink {
my(@names) = @_;
my $cnt = 0;
foreach my $name (@names) {
next unless -e $name;
chmod 0777, $name if $^O eq 'os2';
print " unlink $name\n" if $opts{verbose};
( CORE::unlink($name) and ++$cnt
or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify};
}
return $cnt;
}
sub link {
my($from,$to) = @_;
my($success) = 0;
print " ln $from $to\n" if $opts{verbose};
eval {
CORE::link($from, $to)
? $success++
: ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
? die "AFS" # okay inside eval {}
: warn "Couldn't link $from to $to: $!\n"
unless $opts{notify};
};
if ($@) {
File::Copy::copy($from, $to)
? $success++
: warn "Couldn't copy $from to $to: $!\n"
unless $opts{notify};
}
$success;
}
sub rename {
my($from,$to) = @_;
if (-f $to and not unlink($to)) {
my($i);
for ($i = 1; $i < 50; $i++) {
last if CORE::rename($to, "$to.$i");
}
warn("Cannot rename to `$to.$i': $!"), return 0
if $i >= 50; # Give up!
}
link($from,$to) || return 0;
unlink($from);
}
sub chmod {
my($mode,$name) = @_;
printf " chmod %o %s\n", $mode, $name if $opts{verbose};
CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
unless $opts{notify};
}
sub samepath {
my($p1, $p2) = @_;
my($dev1, $ino1, $dev2, $ino2);
if ($p1 ne $p2) {
($dev1, $ino1) = stat($p1);
($dev2, $ino2) = stat($p2);
($dev1 == $dev2 && $ino1 == $ino2);
}
else {
1;
}
}
--- NEW FILE: dosish.h ---
/* dosish.h
*
* Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#define ABORT() abort();
#ifndef SH_PATH
#define SH_PATH "/bin/sh"
#endif
#ifdef DJGPP
# define BIT_BUCKET "nul"
# define OP_BINARY O_BINARY
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v)
# define init_os_extras Perl_init_os_extras
# include <signal.h>
# define HAS_UTIME
# define HAS_KILL
char *djgpp_pathexp (const char*);
void Perl_DJGPP_init (int *argcp,char ***argvp);
# if (DJGPP==2 && DJGPP_MINOR < 2)
# define NO_LOCALECONV_MON_THOUSANDS_SEP
# endif
# ifdef USE_5005THREADS
# define OLD_PTHREADS_API
# endif
# define PERL_FS_VER_FMT "%d_%d_%d"
#else /* DJGPP */
# ifdef WIN32
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v)
# define PERL_SYS_TERM() Perl_win32_term()
# define BIT_BUCKET "nul"
# else
# ifdef NETWARE
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) Perl_nw5_init(c,v)
# define BIT_BUCKET "nwnul"
# else
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v)
# define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
# endif /* NETWARE */
# endif
#endif /* DJGPP */
#ifndef PERL_SYS_TERM
# define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM
#endif
#define dXSUB_SYS
/*
* 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were
* running on DOS, *and* if we had to cope with 16 bit memory addressing
* constraints, *and* we need to have memory allocated as unsigned long.
*
* with the advent of *real* compilers for DOS, they are not locked together.
* MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have
* 16 bit memory addressing constraints".
*
* if you need the last, try #DEFINE MEM_SIZE unsigned long.
*/
#ifdef MSDOS
# ifndef DJGPP
# define HAS_64K_LIMIT
# endif
#endif
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
#undef USEMYBINMODE
/* Stat_t:
* This symbol holds the type used to declare buffers for information
* returned by stat(). It's usually just struct stat. It may be necessary
* to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
* information.
*/
#if defined(WIN64) || defined(USE_LARGE_FILES)
# if defined(__BORLANDC__) /* buk */
# include <sys\stat.h>
# define Stat_t struct stati64
# else
#define Stat_t struct _stati64
# endif
#else
#if defined(UNDER_CE)
#define Stat_t struct xcestat
#else
#define Stat_t struct stat
#endif
#endif
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
*/
#define USE_STAT_RDEV /**/
/* ACME_MESS:
* This symbol, if defined, indicates that error messages should be
* should be generated in a format that allows the use of the Acme
* GUI/editor's autofind feature.
*/
#undef ACME_MESS /**/
/* ALTERNATE_SHEBANG:
* This symbol, if defined, contains a "magic" string which may be used
* as the first line of a Perl program designed to be executed directly
* by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
* begins with a character other then #, then Perl will only treat
* it as a command line if it finds the string "perl" in the first
* word; otherwise it's treated as the first line of code in the script.
* (IOW, Perl won't hand off to another interpreter via an alternate
* shebang sequence that might be legal Perl code.)
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
* fwrite() itself, which on some systems outputs several distinct records
* if the number_of_items parameter is >1).
*/
#define fwrite1 fwrite
#define Fstat(fd,bufptr) fstat((fd),(bufptr))
#ifdef DJGPP
# define Fflush(fp) djgpp_fflush(fp)
#else
# define Fflush(fp) fflush(fp)
#endif
#define Mkdir(path,mode) mkdir((path),(mode))
#ifndef WIN32
# define Stat(fname,bufptr) stat((fname),(bufptr))
#else
# define HAS_IOCTL
# define HAS_UTIME
# define HAS_KILL
# define HAS_WAIT
# define HAS_CHOWN
#endif /* WIN32 */
/*
* <rich at phekda.freeserve.co.uk>: The DJGPP port has code that converts
* the return code of system() into the form that Unixy wait usually
* returns:
*
* - signal number in bits 0-6;
* - core dump flag in bit 7;
* - exit code in bits 8-15.
*
* Bits 0-7 are always zero for DJGPP, because it uses system().
* See djgpp.c.
*
* POSIX::W* use the W* macros from <sys/wait.h> to decode
* the return code. Unfortunately the W* macros for DJGPP use
* a different format than Unixy wait does. So there's a mismatch
* and, say, WEXITSTATUS($?) will return bogus values.
*
* So here we add hack to redefine the W* macros from DJGPP's <sys/wait.h>
* to work with our return-code conversion.
*/
#ifdef DJGPP
#include <sys/wait.h>
#undef WEXITSTATUS
#undef WIFEXITED
#undef WIFSIGNALED
#undef WIFSTOPPED
#undef WNOHANG
#undef WSTOPSIG
#undef WTERMSIG
#undef WUNTRACED
#define WEXITSTATUS(stat_val) ((stat_val) >> 8)
#define WIFEXITED(stat_val) 0
#define WIFSIGNALED(stat_val) 0
#define WIFSTOPPED(stat_val) 0
#define WNOHANG 0
#define WSTOPSIG(stat_val) 0
#define WTERMSIG(stat_val) 0
#define WUNTRACED 0
#endif
--- NEW FILE: regcomp.h ---
/* regcomp.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
typedef OP OP_4tree; /* Will be redefined later. */
/*
* The "internal use only" fields in regexp.h are present to pass info from
* compile to execute that permits the execute phase to run lots faster on
* simple cases. They are:
*
* regstart sv that must begin a match; Nullch if none obvious
* reganch is the match anchored (at beginning-of-line only)?
* regmust string (pointer into program) that match must include, or NULL
* [regmust changed to SV* for bminstr()--law]
* regmlen length of regmust string
* [regmlen not used currently]
*
* Regstart and reganch permit very fast decisions on suitable starting points
* for a match, cutting down the work a lot. Regmust permits fast rejection
* of lines that cannot possibly match. The regmust tests are costly enough
* that pregcomp() supplies a regmust only if the r.e. contains something
* potentially expensive (at present, the only such thing detected is * or +
* at the start of the r.e., which can involve a lot of backup). Regmlen is
* supplied because the test in pregexec() needs it and pregcomp() is computing
* it anyway.
* [regmust is now supplied always. The tests that use regmust have a
* heuristic that disables the test if it usually matches.]
*
* [In fact, we now use regmust in many cases to locate where the search
* starts in the string, so if regback is >= 0, the regmust search is never
* wasted effort. The regback variable says how many characters back from
* where regmust matched is the earliest possible start of the match.
* For instance, /[a-z].foo/ has a regmust of 'foo' and a regback of 2.]
*/
/*
* Structure for regexp "program". This is essentially a linear encoding
* of a nondeterministic finite-state machine (aka syntax charts or
* "railroad normal form" in parsing technology). Each node is an opcode
* plus a "next" pointer, possibly plus an operand. "Next" pointers of
* all nodes except BRANCH implement concatenation; a "next" pointer with
* a BRANCH on both ends of it is connecting two alternatives. (Here we
* have one of the subtle syntax dependencies: an individual BRANCH (as
* opposed to a collection of them) is never concatenated with anything
* because of operator precedence.) The operand of some types of node is
* a literal string; for others, it is a node leading into a sub-FSM. In
* particular, the operand of a BRANCH node is the first node of the branch.
* (NB this is *not* a tree structure: the tail of the branch connects
* to the thing following the set of BRANCHes.) The opcodes are:
*/
/*
* A node is one char of opcode followed by two chars of "next" pointer.
* "Next" pointers are stored as two 8-bit pieces, high order first. The
* value is a positive offset from the opcode of the node containing it.
* An operand, if any, simply follows the node. (Note that much of the
* code generation knows about this implicit relationship.)
*
* Using two bytes for the "next" pointer is vast overkill for most things,
* but allows patterns to get big without disasters.
*
* [The "next" pointer is always aligned on an even
* boundary, and reads the offset directly as a short. Also, there is no
* special test to reverse the sign of BACK pointers since the offset is
* stored negative.]
*/
struct regnode_string {
U8 str_len;
U8 type;
U16 next_off;
char string[1];
};
struct regnode_1 {
U8 flags;
U8 type;
U16 next_off;
U32 arg1;
};
struct regnode_2 {
U8 flags;
U8 type;
U16 next_off;
U16 arg1;
U16 arg2;
};
#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */
#define ANYOF_CLASSBITMAP_SIZE 4 /* up to 32 (8*4) named classes */
struct regnode_charclass {
U8 flags;
U8 type;
U16 next_off;
U32 arg1;
char bitmap[ANYOF_BITMAP_SIZE]; /* only compile-time */
};
struct regnode_charclass_class { /* has [[:blah:]] classes */
U8 flags; /* should have ANYOF_CLASS here */
U8 type;
U16 next_off;
U32 arg1;
char bitmap[ANYOF_BITMAP_SIZE]; /* both compile-time */
char classflags[ANYOF_CLASSBITMAP_SIZE]; /* and run-time */
};
/* XXX fix this description.
Impose a limit of REG_INFTY on various pattern matching operations
to limit stack growth and to avoid "infinite" recursions.
*/
/* The default size for REG_INFTY is I16_MAX, which is the same as
SHORT_MAX (see perl.h). Unfortunately I16 isn't necessarily 16 bits
(see handy.h). On the Cray C90, sizeof(short)==4 and hence I16_MAX is
((1<<31)-1), while on the Cray T90, sizeof(short)==8 and I16_MAX is
((1<<63)-1). To limit stack growth to reasonable sizes, supply a
smaller default.
--Andy Dougherty 11 June 1998
*/
#if SHORTSIZE > 2
# ifndef REG_INFTY
# define REG_INFTY ((1<<15)-1)
# endif
#endif
#ifndef REG_INFTY
# define REG_INFTY I16_MAX
#endif
#define ARG_VALUE(arg) (arg)
#define ARG__SET(arg,val) ((arg) = (val))
#undef ARG
#undef ARG1
#undef ARG2
#define ARG(p) ARG_VALUE(ARG_LOC(p))
#define ARG1(p) ARG_VALUE(ARG1_LOC(p))
#define ARG2(p) ARG_VALUE(ARG2_LOC(p))
#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val))
#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val))
#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val))
#undef NEXT_OFF
#undef NODE_ALIGN
#define NEXT_OFF(p) ((p)->next_off)
#define NODE_ALIGN(node)
#define NODE_ALIGN_FILL(node) ((node)->flags = 0xde) /* deadbeef */
#define SIZE_ALIGN NODE_ALIGN
#undef OP
#undef OPERAND
#undef MASK
#undef STRING
#define OP(p) ((p)->type)
#define OPERAND(p) (((struct regnode_string *)p)->string)
#define MASK(p) ((char*)OPERAND(p))
#define STR_LEN(p) (((struct regnode_string *)p)->str_len)
#define STRING(p) (((struct regnode_string *)p)->string)
#define STR_SZ(l) ((l + sizeof(regnode) - 1) / sizeof(regnode))
#define NODE_SZ_STR(p) (STR_SZ(STR_LEN(p))+1)
#undef NODE_ALIGN
#undef ARG_LOC
#undef NEXTOPER
#undef PREVOPER
#define NODE_ALIGN(node)
#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1)
#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1)
#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2)
#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */
#define EXTRA_STEP_2ARGS EXTRA_SIZE(struct regnode_2)
#define NODE_STEP_B 4
#define NEXTOPER(p) ((p) + NODE_STEP_REGNODE)
#define PREVOPER(p) ((p) - NODE_STEP_REGNODE)
#define FILL_ADVANCE_NODE(ptr, op) STMT_START { \
(ptr)->type = op; (ptr)->next_off = 0; (ptr)++; } STMT_END
#define FILL_ADVANCE_NODE_ARG(ptr, op, arg) STMT_START { \
ARG_SET(ptr, arg); FILL_ADVANCE_NODE(ptr, op); (ptr) += 1; } STMT_END
#define REG_MAGIC 0234
#define SIZE_ONLY (RExC_emit == &PL_regdummy)
/* Flags for node->flags of ANYOF */
#define ANYOF_CLASS 0x08 /* has [[:blah:]] classes */
#define ANYOF_INVERT 0x04
#define ANYOF_FOLD 0x02
#define ANYOF_LOCALE 0x01
/* Used for regstclass only */
#define ANYOF_EOS 0x10 /* Can match an empty string too */
/* There is a character or a range past 0xff */
#define ANYOF_UNICODE 0x20
#define ANYOF_UNICODE_ALL 0x40 /* Can match any char past 0xff */
/* size of node is large (includes class pointer) */
#define ANYOF_LARGE 0x80
/* Are there any runtime flags on in this node? */
#define ANYOF_RUNTIME(s) (ANYOF_FLAGS(s) & 0x0f)
#define ANYOF_FLAGS_ALL 0xff
/* Character classes for node->classflags of ANYOF */
/* Should be synchronized with a table in regprop() */
/* 2n should pair with 2n+1 */
#define ANYOF_ALNUM 0 /* \w, PL_utf8_alnum, utf8::IsWord, ALNUM */
#define ANYOF_NALNUM 1
#define ANYOF_SPACE 2 /* \s */
#define ANYOF_NSPACE 3
#define ANYOF_DIGIT 4
#define ANYOF_NDIGIT 5
#define ANYOF_ALNUMC 6 /* isalnum(3), utf8::IsAlnum, ALNUMC */
#define ANYOF_NALNUMC 7
#define ANYOF_ALPHA 8
#define ANYOF_NALPHA 9
#define ANYOF_ASCII 10
#define ANYOF_NASCII 11
#define ANYOF_CNTRL 12
#define ANYOF_NCNTRL 13
#define ANYOF_GRAPH 14
#define ANYOF_NGRAPH 15
#define ANYOF_LOWER 16
#define ANYOF_NLOWER 17
#define ANYOF_PRINT 18
#define ANYOF_NPRINT 19
#define ANYOF_PUNCT 20
#define ANYOF_NPUNCT 21
#define ANYOF_UPPER 22
#define ANYOF_NUPPER 23
#define ANYOF_XDIGIT 24
#define ANYOF_NXDIGIT 25
#define ANYOF_PSXSPC 26 /* POSIX space: \s plus the vertical tab */
#define ANYOF_NPSXSPC 27
#define ANYOF_BLANK 28 /* GNU extension: space and tab: non-vertical space */
#define ANYOF_NBLANK 29
#define ANYOF_MAX 32
/* Backward source code compatibility. */
#define ANYOF_ALNUML ANYOF_ALNUM
#define ANYOF_NALNUML ANYOF_NALNUM
#define ANYOF_SPACEL ANYOF_SPACE
#define ANYOF_NSPACEL ANYOF_NSPACE
/* Utility macros for the bitmap and classes of ANYOF */
#define ANYOF_SIZE (sizeof(struct regnode_charclass))
#define ANYOF_CLASS_SIZE (sizeof(struct regnode_charclass_class))
#define ANYOF_FLAGS(p) ((p)->flags)
#define ANYOF_BIT(c) (1 << ((c) & 7))
#define ANYOF_CLASS_BYTE(p, c) (((struct regnode_charclass_class*)(p))->classflags[((c) >> 3) & 3])
#define ANYOF_CLASS_SET(p, c) (ANYOF_CLASS_BYTE(p, c) |= ANYOF_BIT(c))
#define ANYOF_CLASS_CLEAR(p, c) (ANYOF_CLASS_BYTE(p, c) &= ~ANYOF_BIT(c))
#define ANYOF_CLASS_TEST(p, c) (ANYOF_CLASS_BYTE(p, c) & ANYOF_BIT(c))
#define ANYOF_CLASS_ZERO(ret) Zero(((struct regnode_charclass_class*)(ret))->classflags, ANYOF_CLASSBITMAP_SIZE, char)
#define ANYOF_BITMAP_ZERO(ret) Zero(((struct regnode_charclass*)(ret))->bitmap, ANYOF_BITMAP_SIZE, char)
#define ANYOF_BITMAP(p) (((struct regnode_charclass*)(p))->bitmap)
#define ANYOF_BITMAP_BYTE(p, c) (ANYOF_BITMAP(p)[((c) >> 3) & 31])
#define ANYOF_BITMAP_SET(p, c) (ANYOF_BITMAP_BYTE(p, c) |= ANYOF_BIT(c))
#define ANYOF_BITMAP_CLEAR(p,c) (ANYOF_BITMAP_BYTE(p, c) &= ~ANYOF_BIT(c))
#define ANYOF_BITMAP_TEST(p, c) (ANYOF_BITMAP_BYTE(p, c) & ANYOF_BIT(c))
#define ANYOF_BITMAP_SETALL(p) \
memset (ANYOF_BITMAP(p), 255, ANYOF_BITMAP_SIZE)
#define ANYOF_BITMAP_CLEARALL(p) \
Zero (ANYOF_BITMAP(p), ANYOF_BITMAP_SIZE)
/* Check that all 256 bits are all set. Used in S_cl_is_anything() */
#define ANYOF_BITMAP_TESTALLSET(p) \
memEQ (ANYOF_BITMAP(p), "\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377", ANYOF_BITMAP_SIZE)
#define ANYOF_SKIP ((ANYOF_SIZE - 1)/sizeof(regnode))
#define ANYOF_CLASS_SKIP ((ANYOF_CLASS_SIZE - 1)/sizeof(regnode))
#define ANYOF_CLASS_ADD_SKIP (ANYOF_CLASS_SKIP - ANYOF_SKIP)
/*
* Utility definitions.
*/
#ifndef CHARMASK
# define UCHARAT(p) ((int)*(const U8*)(p))
#else
# define UCHARAT(p) ((int)*(p)&CHARMASK)
#endif
#define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode))
#define REG_SEEN_ZERO_LEN 1
#define REG_SEEN_LOOKBEHIND 2
#define REG_SEEN_GPOS 4
#define REG_SEEN_EVAL 8
#define REG_SEEN_CANY 16
#define REG_SEEN_SANY REG_SEEN_CANY /* src bckwrd cmpt */
START_EXTERN_C
#include "regnodes.h"
/* The following have no fixed length. U8 so we can do strchr() on it. */
#ifndef DOINIT
EXTCONST U8 PL_varies[];
#else
EXTCONST U8 PL_varies[] = {
BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL,
WHILEM, CURLYM, CURLYN, BRANCHJ, IFTHEN, SUSPEND, CLUMP, 0
};
#endif
/* The following always have a length of 1. U8 we can do strchr() on it. */
/* (Note that length 1 means "one character" under UTF8, not "one octet".) */
#ifndef DOINIT
EXTCONST U8 PL_simple[];
#else
EXTCONST U8 PL_simple[] = {
REG_ANY, SANY, CANY,
ANYOF,
ALNUM, ALNUML,
NALNUM, NALNUML,
SPACE, SPACEL,
NSPACE, NSPACEL,
DIGIT, NDIGIT,
0
};
#endif
END_EXTERN_C
typedef struct re_scream_pos_data_s
{
char **scream_olds; /* match pos */
I32 *scream_pos; /* Internal iterator of scream. */
} re_scream_pos_data;
/* .what is a character array with one character for each member of .data
* The character describes the function of the corresponding .data item:
* f - start-class data for regstclass optimization
* n - Root of op tree for (?{EVAL}) item
* o - Start op for (?{EVAL}) item
* p - Pad for (?{EVAL} item
* s - swash for unicode-style character class, and the multicharacter
* strings resulting from casefolding the single-character entries
* in the character class
* 20010712 mjd at plover.com
* (Remember to update re_dup() and pregfree() if you add any items.)
*/
struct reg_data {
U32 count;
U8 *what;
void* data[1];
};
struct reg_substr_datum {
I32 min_offset;
I32 max_offset;
SV *substr; /* non-utf8 variant */
SV *utf8_substr; /* utf8 variant */
};
struct reg_substr_data {
struct reg_substr_datum data[3]; /* Actual array */
};
#define anchored_substr substrs->data[0].substr
#define anchored_utf8 substrs->data[0].utf8_substr
#define anchored_offset substrs->data[0].min_offset
#define float_substr substrs->data[1].substr
#define float_utf8 substrs->data[1].utf8_substr
#define float_min_offset substrs->data[1].min_offset
#define float_max_offset substrs->data[1].max_offset
#define check_substr substrs->data[2].substr
#define check_utf8 substrs->data[2].utf8_substr
#define check_offset_min substrs->data[2].min_offset
#define check_offset_max substrs->data[2].max_offset
--- NEW FILE: scope.h ---
/* scope.h
*
* Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#define SAVEt_ITEM 0
#define SAVEt_SV 1
#define SAVEt_AV 2
#define SAVEt_HV 3
#define SAVEt_INT 4
#define SAVEt_LONG 5
#define SAVEt_I32 6
#define SAVEt_IV 7
#define SAVEt_SPTR 8
#define SAVEt_APTR 9
#define SAVEt_HPTR 10
#define SAVEt_PPTR 11
#define SAVEt_NSTAB 12
#define SAVEt_SVREF 13
#define SAVEt_GP 14
#define SAVEt_FREESV 15
#define SAVEt_FREEOP 16
#define SAVEt_FREEPV 17
#define SAVEt_CLEARSV 18
#define SAVEt_DELETE 19
#define SAVEt_DESTRUCTOR 20
#define SAVEt_REGCONTEXT 21
#define SAVEt_STACK_POS 22
#define SAVEt_I16 23
#define SAVEt_AELEM 24
#define SAVEt_HELEM 25
#define SAVEt_OP 26
#define SAVEt_HINTS 27
#define SAVEt_ALLOC 28
#define SAVEt_GENERIC_SVREF 29
#define SAVEt_DESTRUCTOR_X 30
#define SAVEt_VPTR 31
#define SAVEt_I8 32
#define SAVEt_COMPPAD 33
#define SAVEt_GENERIC_PVREF 34
#define SAVEt_PADSV 35
#define SAVEt_MORTALIZESV 36
#define SAVEt_SHARED_PVREF 37
#define SAVEt_BOOL 38
#define SAVEt_SAVESWITCHSTACK 40
#ifndef SCOPE_SAVES_SIGNAL_MASK
#define SCOPE_SAVES_SIGNAL_MASK 0
#endif
#define SSCHECK(need) if (PL_savestack_ix + (need) > PL_savestack_max) savestack_grow()
#define SSGROW(need) if (PL_savestack_ix + (need) > PL_savestack_max) savestack_grow_cnt(need)
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
#define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p))
#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i))
#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p))
#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p))
#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p))
#define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32)
#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long)
#define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool)
#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv)
#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr)
#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr)
#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr)
/*
=head1 Callback Functions
=for apidoc Ams||SAVETMPS
Opening bracket for temporaries on a callback. See C<FREETMPS> and
L<perlcall>.
=for apidoc Ams||FREETMPS
Closing bracket for temporaries on a callback. See C<SAVETMPS> and
L<perlcall>.
=for apidoc Ams||ENTER
Opening bracket on a callback. See C<LEAVE> and L<perlcall>.
=for apidoc Ams||LEAVE
Closing bracket on a callback. See C<ENTER> and L<perlcall>.
=cut
*/
#define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix
#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
#ifdef DEBUGGING
#define ENTER \
STMT_START { \
push_scope(); \
DEBUG_SCOPE("ENTER") \
} STMT_END
#define LEAVE \
STMT_START { \
DEBUG_SCOPE("LEAVE") \
pop_scope(); \
} STMT_END
#else
#define ENTER push_scope()
#define LEAVE pop_scope()
#endif
#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
/*
* Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV
* because these are used for several kinds of pointer values
*/
#define SAVEI8(i) save_I8(SOFT_CAST(I8*)&(i))
#define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i))
#define SAVEI32(i) save_I32(SOFT_CAST(I32*)&(i))
#define SAVEINT(i) save_int(SOFT_CAST(int*)&(i))
#define SAVEIV(i) save_iv(SOFT_CAST(IV*)&(i))
#define SAVELONG(l) save_long(SOFT_CAST(long*)&(l))
#define SAVEBOOL(b) save_bool(SOFT_CAST(bool*)&(b))
#define SAVESPTR(s) save_sptr((SV**)&(s))
#define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s))
#define SAVEVPTR(s) save_vptr((void*)&(s))
#define SAVEPADSV(s) save_padsv(s)
#define SAVEFREESV(s) save_freesv((SV*)(s))
#define SAVEMORTALIZESV(s) save_mortalizesv((SV*)(s))
#define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o))
#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p))
#define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv))
#define SAVEGENERICSV(s) save_generic_svref((SV**)&(s))
#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s))
#define SAVESHAREDPV(s) save_shared_pvref((char**)&(s))
#define SAVEDELETE(h,k,l) \
save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
#define SAVEDESTRUCTOR(f,p) \
save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), SOFT_CAST(void*)(p))
#define SAVEDESTRUCTOR_X(f,p) \
save_destructor_x((DESTRUCTORFUNC_t)(f), SOFT_CAST(void*)(p))
#define SAVESTACK_POS() \
STMT_START { \
SSCHECK(2); \
SSPUSHINT(PL_stack_sp - PL_stack_base); \
SSPUSHINT(SAVEt_STACK_POS); \
} STMT_END
#define SAVEOP() save_op()
#define SAVEHINTS() \
STMT_START { \
SSCHECK(3); \
if (PL_hints & HINT_LOCALIZE_HH) { \
SSPUSHPTR(GvHV(PL_hintgv)); \
GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv)); \
} \
SSPUSHINT(PL_hints); \
SSPUSHINT(SAVEt_HINTS); \
} STMT_END
#define SAVECOMPPAD() \
STMT_START { \
SSCHECK(2); \
SSPUSHPTR((SV*)PL_comppad); \
SSPUSHINT(SAVEt_COMPPAD); \
} STMT_END
#define SAVESWITCHSTACK(f,t) \
STMT_START { \
SSCHECK(3); \
SSPUSHPTR((SV*)(f)); \
SSPUSHPTR((SV*)(t)); \
SSPUSHINT(SAVEt_SAVESWITCHSTACK); \
SWITCHSTACK((f),(t)); \
PL_curstackinfo->si_stack = (t); \
} STMT_END
#ifdef USE_ITHREADS
# define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c))
# define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c))
# define SAVECOPFILE(c) SAVEPPTR(CopFILE(c))
# define SAVECOPFILE_FREE(c) SAVESHAREDPV(CopFILE(c))
#else
# define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c))
# define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */
# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c))
# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c))
#endif
#define SAVECOPLINE(c) SAVEI32(CopLINE(c))
/* SSNEW() temporarily allocates a specified number of bytes of data on the
* savestack. It returns an integer index into the savestack, because a
* pointer would get broken if the savestack is moved on reallocation.
* SSNEWa() works like SSNEW(), but also aligns the data to the specified
* number of bytes. MEM_ALIGNBYTES is perhaps the most useful. The
* alignment will be preserved therough savestack reallocation *only* if
* realloc returns data aligned to a size divisible by "align"!
*
* SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer.
*/
#define SSNEW(size) Perl_save_alloc(aTHX_ (size), 0)
#define SSNEWt(n,t) SSNEW((n)*sizeof(t))
#define SSNEWa(size,align) Perl_save_alloc(aTHX_ (size), \
(align - ((int)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align)
#define SSNEWat(n,t,align) SSNEWa((n)*sizeof(t), align)
#define SSPTR(off,type) ((type) ((char*)PL_savestack + off))
#define SSPTRt(off,type) ((type*) ((char*)PL_savestack + off))
/* A jmpenv packages the state required to perform a proper non-local jump.
* Note that there is a start_env initialized when perl starts, and top_env
* points to this initially, so top_env should always be non-null.
*
* Existence of a non-null top_env->je_prev implies it is valid to call
* longjmp() at that runlevel (we make sure start_env.je_prev is always
* null to ensure this).
*
* je_mustcatch, when set at any runlevel to TRUE, means eval ops must
* establish a local jmpenv to handle exception traps. Care must be taken
* to restore the previous value of je_mustcatch before exiting the
* stack frame iff JMPENV_PUSH was not called in that stack frame.
* GSAR 97-03-27
*/
struct jmpenv {
struct jmpenv * je_prev;
Sigjmp_buf je_buf; /* only for use if !je_throw */
int je_ret; /* last exception thrown */
bool je_mustcatch; /* need to call longjmp()? */
#ifdef PERL_FLEXIBLE_EXCEPTIONS
void (*je_throw)(int v); /* last for bincompat */
bool je_noset; /* no need for setjmp() */
#endif
};
typedef struct jmpenv JMPENV;
#ifdef OP_IN_REGISTER
#define OP_REG_TO_MEM PL_opsave = op
#define OP_MEM_TO_REG op = PL_opsave
#else
#define OP_REG_TO_MEM NOOP
#define OP_MEM_TO_REG NOOP
#endif
/*
* How to build the first jmpenv.
*
* top_env needs to be non-zero. It points to an area
* in which longjmp() stuff is stored, as C callstack
* info there at least is thread specific this has to
* be per-thread. Otherwise a 'die' in a thread gives
* that thread the C stack of last thread to do an eval {}!
*/
#define JMPENV_BOOTSTRAP \
STMT_START { \
Zero(&PL_start_env, 1, JMPENV); \
PL_start_env.je_ret = -1; \
PL_start_env.je_mustcatch = TRUE; \
PL_top_env = &PL_start_env; \
} STMT_END
#ifdef PERL_FLEXIBLE_EXCEPTIONS
/*
* These exception-handling macros are split up to
* ease integration with C++ exceptions.
*
* To use C++ try+catch to catch Perl exceptions, an extension author
* needs to first write an extern "C" function to throw an appropriate
* exception object; typically it will be or contain an integer,
* because Perl's internals use integers to track exception types:
* extern "C" { static void thrower(int i) { throw i; } }
*
* Then (as shown below) the author needs to use, not the simple
* JMPENV_PUSH, but several of its constitutent macros, to arrange for
* the Perl internals to call thrower() rather than longjmp() to
* report exceptions:
*
* dJMPENV;
* JMPENV_PUSH_INIT(thrower);
* try {
* ... stuff that may throw exceptions ...
* }
* catch (int why) { // or whatever matches thrower()
* JMPENV_POST_CATCH;
* EXCEPT_SET(why);
* switch (why) {
* ... // handle various Perl exception codes
* }
* }
* JMPENV_POP; // don't forget this!
*/
/*
* Function that catches/throws, and its callback for the
* body of protected processing.
*/
typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
int *, protect_body_t, ...);
#define dJMPENV JMPENV cur_env; \
volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env)
#define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \
STMT_START { \
(ce).je_throw = (THROWFUNC); \
(ce).je_ret = -1; \
(ce).je_mustcatch = FALSE; \
(ce).je_prev = PL_top_env; \
PL_top_env = &(ce); \
OP_REG_TO_MEM; \
} STMT_END
#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC)
#define JMPENV_POST_CATCH_ENV(ce) \
STMT_START { \
OP_MEM_TO_REG; \
PL_top_env = &(ce); \
} STMT_END
#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env)
#define JMPENV_PUSH_ENV(ce,v) \
STMT_START { \
if (!(ce).je_noset) { \
DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
ce, PL_top_env)); \
JMPENV_PUSH_INIT_ENV(ce,NULL); \
EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, SCOPE_SAVES_SIGNAL_MASK));\
(ce).je_noset = 1; \
} \
else \
EXCEPT_SET_ENV(ce,0); \
JMPENV_POST_CATCH_ENV(ce); \
(v) = EXCEPT_GET_ENV(ce); \
} STMT_END
#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v)
#define JMPENV_POP_ENV(ce) \
STMT_START { \
if (PL_top_env == &(ce)) \
PL_top_env = (ce).je_prev; \
} STMT_END
#define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env)
#define JMPENV_JUMP(v) \
STMT_START { \
OP_REG_TO_MEM; \
if (PL_top_env->je_prev) { \
if (PL_top_env->je_throw) \
PL_top_env->je_throw(v); \
else \
PerlProc_longjmp(PL_top_env->je_buf, (v)); \
} \
if ((v) == 2) \
PerlProc_exit(STATUS_NATIVE_EXPORT); \
PerlIO_printf(Perl_error_log, "panic: top_env\n"); \
PerlProc_exit(1); \
} STMT_END
#define EXCEPT_GET_ENV(ce) ((ce).je_ret)
#define EXCEPT_GET EXCEPT_GET_ENV(*(JMPENV*)pcur_env)
#define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v))
#define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v)
#else /* !PERL_FLEXIBLE_EXCEPTIONS */
#define dJMPENV JMPENV cur_env
#define JMPENV_PUSH(v) \
STMT_START { \
DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
&cur_env, PL_top_env)); \
cur_env.je_prev = PL_top_env; \
OP_REG_TO_MEM; \
cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \
OP_MEM_TO_REG; \
PL_top_env = &cur_env; \
cur_env.je_mustcatch = FALSE; \
(v) = cur_env.je_ret; \
} STMT_END
#define JMPENV_POP \
STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
#define JMPENV_JUMP(v) \
STMT_START { \
OP_REG_TO_MEM; \
if (PL_top_env->je_prev) \
PerlProc_longjmp(PL_top_env->je_buf, (v)); \
if ((v) == 2) \
PerlProc_exit(STATUS_NATIVE_EXPORT); \
PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
PerlProc_exit(1); \
} STMT_END
#endif /* PERL_FLEXIBLE_EXCEPTIONS */
#define CATCH_GET (PL_top_env->je_mustcatch)
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
--- NEW FILE: embedvar.h ---
/* -*- buffer-read-only: t -*-
*
* embedvar.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by embed.pl from data in embed.fnc, embed.pl,
* pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
* Any changes made here will be lost!
*
* Edit those files and run 'make regen_headers' to effect changes.
*/
/* (Doing namespace management portably in C is really gross.) */
[...1474 lines suppressed...]
#define na PL_na
#define no_modify PL_no_modify
#define perl_destruct_level PL_perl_destruct_level
#define perldb PL_perldb
#define ppaddr PL_ppaddr
#define rsfp PL_rsfp
#define rsfp_filters PL_rsfp_filters
#define stack_base PL_stack_base
#define stack_sp PL_stack_sp
#define stdingv PL_stdingv
#define sv_arenaroot PL_sv_arenaroot
#define sv_no PL_sv_no
#define sv_undef PL_sv_undef
#define sv_yes PL_sv_yes
#define tainted PL_tainted
#define tainting PL_tainting
#endif /* PERL_POLLUTE */
/* ex: set ro: */
--- NEW FILE: README.cn ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
The following documentation is written in EUC-CN encoding.
Èç¹ûÄãÓÃÒ»°ãµÄÎÄ×Ö±à¼Æ÷ÔÄÀÀÕâ·ÝÎļþ, ÇëºöÂÔÎÄÖÐÆæÌصÄ×¢¼Ç×Ö·û.
Õâ·ÝÎļþÊÇÒÔ POD (¼òÃ÷Îļþ¸ñʽ) д³É; ÕâÖÖ¸ñʽÊÇΪÁËÄÜÈÃÈËÖ±½ÓÔĶÁ,
¶øÌرðÉè¼ÆµÄ. ¹ØÓڴ˸ñʽµÄ½øÒ»²½ÐÅÏ¢, Çë²Î¿¼ perlpod ÏßÉÏÎļþ.
=head1 NAME
perlcn - ¼òÌåÖÐÎÄ Perl Ö¸ÄÏ
=head1 DESCRIPTION
»¶ÓÀ´µ½ Perl µÄÌìµØ!
´Ó 5.8.0 °æ¿ªÊ¼, Perl ¾ß±¸ÁËÍêÉÆµÄ Unicode (ͳһÂë) Ö§Ô®,
Ò²Á¬´øÖ§Ô®ÁËÐí¶àÀ¶¡ÓïϵÒÔÍâµÄ±àÂ뷽ʽ; CJK (ÖÐÈÕº«) ±ãÊÇÆäÖеÄÒ»²¿·Ý.
Unicode Êǹú¼ÊÐԵıê×¼, ÊÔͼº¸ÇÊÀ½çÉÏËùÓеÄ×Ö·û: Î÷·½ÊÀ½ç, ¶«·½ÊÀ½ç,
ÒÔ¼°Á½Õß¼äµÄÒ»ÇÐ (Ï£À°ÎÄ, ÐðÀûÑÇÎÄ, ÑÇÀ²®ÎÄ, Ï£²®À´ÎÄ, Ó¡¶ÈÎÄ,
Ó¡µØ°²ÎÄ, µÈµÈ). ËüÒ²ÈÝÄÉÁ˶àÖÖ×÷ҵϵͳÓëƽ̨ (Èç PC ¼°Âó½ðËþ).
Perl ±¾ÉíÒÔ Unicode ½øÐвÙ×÷. Õâ±íʾ Perl ÄÚ²¿µÄ×Ö·û´®Êý¾Ý¿ÉÓà Unicode
±íʾ; Perl µÄº¯Ê½ÓëËã·û (ÀýÈçÕý¹æ±íʾʽ±È¶Ô) Ò²ÄÜ¶Ô Unicode ½øÐвÙ×÷.
ÔÚÊäÈë¼°Êä³öʱ, ΪÁË´¦ÀíÒÔ Unicode ֮ǰµÄ±àÂ뷽ʽ´æ·ÅµÄÊý¾Ý, Perl
ÌṩÁË Encode Õâ¸öÄ£¿é, ¿ÉÒÔÈÃÄãÇáÒ׵ضÁÈ¡¼°Ð´Èë¾ÉÓеıàÂëÊý¾Ý.
Encode ÑÓÉìÄ£¿éÖ§Ô®ÏÂÁмòÌåÖÐÎĵıàÂ뷽ʽ ('gb2312' ±íʾ 'euc-cn'):
euc-cn Unix ÑÓÉì×Ö·û¼¯, Ò²¾ÍÊÇË׳ƵĹú±êÂë
gb2312-raw δ¾´¦ÀíµÄ (µÍ±ÈÌØ) GB2312 ×Ö·û±í
gb12345 δ¾´¦ÀíµÄÖйúÓ÷±ÌåÖÐÎıàÂë
iso-ir-165 GB2312 + GB6345 + GB8565 + ÐÂÔö×Ö·û
cp936 ×ÖÂëÒ³ 936, Ò²¿ÉÒÔÓà 'GBK' (À©³ä¹ú±êÂë) Ö¸Ã÷
hz 7 ±ÈÌØÒݳöʽ GB2312 ±àÂë
¾ÙÀýÀ´Ëµ, ½« EUC-CN ±àÂëµÄµµ°¸×ª³É Unicode, ìóÐè¼üÈëÏÂÁÐÖ¸Áî:
perl -Mencoding=euc-cn,STDOUT,utf8 -pe1 < file.euc-cn > file.utf8
Perl Ò²ÄÚ¸½ÁË "piconv", Ò»Ö§ÍêÈ«ÒÔ Perl д³ÉµÄ×Ö·ûת»»¹¤¾ß³ÌÐò, Ó÷¨ÈçÏÂ:
piconv -f euc-cn -t utf8 < file.euc-cn > file.utf8
piconv -f utf8 -t euc-cn < file.utf8 > file.euc-cn
ÁíÍâ, ÀûÓà encoding Ä£¿é, Äã¿ÉÒÔÇáÒ×д³öÒÔ×Ö·ûΪµ¥Î»µÄ³ÌÐòÂë, ÈçÏÂËùʾ:
#!/usr/bin/env perl
# Æô¶¯ euc-cn ×Ö´®½âÎö; ±ê×¼Êä³öÈë¼°±ê×¼´íÎó¶¼ÉèΪ euc-cn ±àÂë
use encoding 'euc-cn', STDIN => 'euc-cn', STDOUT => 'euc-cn';
print length("ÂæÍÕ"); # 2 (Ë«ÒýºÅ±íʾ×Ö·û)
print length('ÂæÍÕ'); # 4 (µ¥ÒýºÅ±íʾ×Ö½Ú)
print index("×»×»½Ì»å", "»×»½"); # -1 (²»°üº¬´Ë×Ó×Ö·û´®)
print index('×»×»½Ì»å', '»×»½'); # 1 (´ÓµÚ¶þ¸ö×Ö½Ú¿ªÊ¼)
ÔÚ×îºóÒ»ÁÐÀý×ÓÀï, "×»" µÄµÚ¶þ¸ö×Ö½ÚÓë "×»" µÄµÚÒ»¸ö×Ö½Ú½áºÏ³É EUC-CN
ÂëµÄ "»×"; "×»" µÄµÚ¶þ¸ö×Ö½ÚÔòÓë "½Ì" µÄµÚÒ»¸ö×Ö½Ú½áºÏ³É "»½".
Õâ½â¾öÁËÒÔÇ° EUC-CN Âë±È¶Ô´¦ÀíÉϳ£¼ûµÄÎÊÌâ.
=head2 ¶îÍâµÄÖÐÎıàÂë
Èç¹ûÐèÒª¸ü¶àµÄÖÐÎıàÂë, ¿ÉÒÔ´Ó CPAN (L<http://www.cpan.org/>) ÏÂÔØ
Encode::HanExtra Ä£¿é. ËüÄ¿Ç°ÌṩÏÂÁбàÂ뷽ʽ:
gb18030 À©³ä¹ýµÄ¹ú±êÂë, °üº¬·±ÌåÖÐÎÄ
ÁíÍâ, Encode::HanConvert Ä£¿éÔòÌṩÁ˼ò·±×ª»»ÓõÄÁ½ÖÖ±àÂë:
big5-simp Big5 ·±ÌåÖÐÎÄÓë Unicode ¼òÌåÖÐÎÄ»¥×ª
gbk-trad GBK ¼òÌåÖÐÎÄÓë Unicode ·±ÌåÖÐÎÄ»¥×ª
ÈôÏëÔÚ GBK Óë Big5 Ö®¼ä»¥×ª, Çë²Î¿¼¸ÃÄ£¿éÄÚ¸½µÄ b2g.pl Óë g2b.pl Á½Ö§³ÌÐò,
»òÔÚ³ÌÐòÄÚʹÓÃÏÂÁÐд·¨:
use Encode::HanConvert;
$euc_cn = big5_to_gb($big5); # ´Ó Big5 תΪ GBK
$big5 = gb_to_big5($euc_cn); # ´Ó GBK תΪ Big5
=head2 ½øÒ»²½µÄÐÅÏ¢
Çë²Î¿¼ Perl ÄÚ¸½µÄ´óÁ¿ËµÃ÷Îļþ (²»ÐÒÈ«ÊÇÓÃÓ¢ÎÄдµÄ), À´Ñ§Ï°¸ü¶à¹ØÓÚ
Perl µÄ֪ʶ, ÒÔ¼° Unicode µÄʹÓ÷½Ê½. ²»¹ý, ÍⲿµÄ×ÊÔ´Ï൱·á¸»:
=head2 Ìṩ Perl ×ÊÔ´µÄÍøÖ·
=over 4
=item L<http://www.perl.com/>
Perl µÄÊ×Ò³ (ÓÉÅ·À³Àñ¹«Ë¾Î¬»¤)
=item L<http://www.cpan.org/>
Perl ×ۺϵä²ØÍø (Comprehensive Perl Archive Network)
=item L<http://lists.perl.org/>
Perl ÓʵÝÂÛ̳һÀÀ
=back
=head2 ѧϰ Perl µÄÍøÖ·
=over 4
=item L<http://www.oreilly.com.cn/html/perl.html>
¼òÌåÖÐÎÄ°æµÄÅ·À³Àñ Perl Êé½å
=back
=head2 Perl ʹÓÃÕß¼¯»á
=over 4
=item L<http://www.pm.org/groups/asia.shtml#China>
Öйú Perl Íƹã×éÒ»ÀÀ
=back
=head2 Unicode Ïà¹ØÍøÖ·
=over 4
=item L<http://www.unicode.org/>
Unicode ѧÊõѧ»á (Unicode ±ê×¼µÄÖƶ¨Õß)
=item L<http://www.cl.cam.ac.uk/%7Emgk25/unicode.html>
Unix/Linux É쵀 UTF-8 ¼° Unicode ´ð¿ÍÎÊ
=back
=head1 SEE ALSO
L<Encode>, L<Encode::CN>, L<encoding>, L<perluniintro>, L<perlunicode>
=head1 AUTHORS
Jarkko Hietaniemi E<lt>jhi at iki.fiE<gt>
Autrijus Tang (ÌÆ×Úºº) E<lt>autrijus at autrijus.orgE<gt>
=cut
--- NEW FILE: utfebcdic.h ---
/* utfebcdic.h
*
* Copyright (C) 2001, 2002, by Larry Wall, Nick Ing-Simmons, and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* Macros to implement UTF-EBCDIC as perl's internal encoding
* Taken from version 7.1 of Unicode Techical Report #16:
* http://www.unicode.org/unicode/reports/tr16
*/
START_EXTERN_C
#ifdef DOINIT
/* Indexed by encoded byte this table gives the length of the sequence.
Adapted from the shadow flags table in tr16.
The entries marked 9 in tr6 are continuation bytes and are marked
as length 1 here so that we can recover.
*/
#if '^' == 95 /* if defined(__MVS__) || defined(??) (VM/ESA?) 1047 */
EXTCONST unsigned char PL_utf8skip[] = {
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,2,2,2,2,2,1,1,1,1,1,1,1,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,1,1,1,1,1,1,1,1,1,2,2,2,1,2,2,
2,2,2,2,2,2,2,3,3,3,3,3,3,1,3,3,
1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,
1,1,1,1,1,1,1,1,1,1,3,3,4,4,4,4,
1,4,1,1,1,1,1,1,1,1,4,4,4,5,5,5,
1,1,1,1,1,1,1,1,1,1,5,6,6,7,7,1
};
#endif
#if '^' == 106 /* if defined(_OSD_POSIX) POSIX-BC */
unsigned char PL_utf8skip[] = {
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,2,2,2,2,2,3,1,1,1,1,1,1,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,3,1,1,1,1,1,1,1,1,2,2,2,3,2,2,
1,2,2,2,2,2,2,3,3,3,2,1,1,1,3,3,
4,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,
1,1,1,1,1,1,1,1,1,1,3,3,4,6,4,4,
7,4,1,1,1,1,1,1,1,1,4,4,4,5,5,5,
1,1,1,1,1,1,1,1,1,1,5,1,6,1,7,1
};
#endif
#if '^' == 176 /* if defined(??) (OS/400?) 037 */
unsigned char PL_utf8skip[] = {
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,2,2,2,2,2,1,1,1,1,1,1,1,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,
2,1,1,1,1,1,1,1,1,1,2,2,2,3,2,2,
1,2,2,2,2,2,2,3,3,3,1,1,3,3,3,3,
1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,
1,1,1,1,1,1,1,1,1,1,3,3,4,4,4,4,
1,4,1,1,1,1,1,1,1,1,4,4,4,5,5,5,
1,1,1,1,1,1,1,1,1,1,5,6,6,7,7,1
};
#endif
/* Transform tables from tr16 applied after encoding to render encoding EBCDIC like */
#if '^' == 95 /* if defined(__MVS__) || defined(??) (VM/ESA?) 1047 */
EXTCONST unsigned char PL_utf2e[] = { /* UTF-8-mod to EBCDIC (IBM-1047) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x15, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x4F, 0xD0, 0xA1, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xFF,
0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56,
0x57, 0x58, 0x59, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x70, 0x71, 0x72, 0x73,
0x74, 0x75, 0x76, 0x77, 0x78, 0x80, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F, 0x90, 0x9A, 0x9B, 0x9C,
0x9D, 0x9E, 0x9F, 0xA0, 0xAA, 0xAB, 0xAC, 0xAE, 0xAF, 0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6,
0xB7, 0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBE, 0xBF, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF, 0xDA, 0xDB,
0xDC, 0xDD, 0xDE, 0xDF, 0xE1, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE,
};
EXTCONST unsigned char PL_e2utf[] = { /* EBCDIC (IBM-1047) to UTF-8-mod */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF, 0xB0, 0xB1, 0xB2, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,
0x2D, 0x2F, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0xBB, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xBC, 0xBD, 0xBE, 0xBF, 0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xC5, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xC6, 0xC7, 0xC8, 0xC9, 0xCA, 0xCB,
0xCC, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xCD, 0xCE, 0xCF, 0xD0, 0xD1, 0xD2,
0xD3, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xD4, 0xD5, 0xD6, 0x5B, 0xD7, 0xD8,
0xD9, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF, 0xE0, 0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0x5D, 0xE6, 0xE7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xEE, 0xEF, 0xF0, 0xF1, 0xF2, 0xF3,
0x5C, 0xF4, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0xFA,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF, 0x9F,
};
#endif /* 1047 */
#if '^' == 106 /* if defined(_OSD_POSIX) POSIX-BC */
unsigned char PL_utf2e[] = { /* UTF-8-mod to EBCDIC (POSIX-BC) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x15, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xBB, 0xBC, 0xBD, 0x6A, 0x6D,
0x4A, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xFB, 0x4F, 0xFD, 0xFF, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0x5F,
0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xB0, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56,
0x57, 0x58, 0x59, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xD0, 0x70, 0x71, 0x72, 0x73,
0x74, 0x75, 0x76, 0x77, 0x78, 0x80, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F, 0x90, 0x9A, 0x9B, 0x9C,
0x9D, 0x9E, 0x9F, 0xA0, 0xAA, 0xAB, 0xAC, 0xAE, 0xAF, 0xBA, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6,
0xB7, 0xB8, 0xB9, 0xAD, 0x79, 0xA1, 0xBE, 0xBF, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF, 0xDA, 0xDB,
0xDC, 0xC0, 0xDE, 0xDF, 0xE1, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF, 0xFA, 0xDD, 0xFC, 0xE0, 0xFE,
};
unsigned char PL_e2utf[] = { /* EBCDIC (POSIX-BC) to UTF-8-mod */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0x60, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF, 0xB0, 0xB1, 0xB2, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x9F,
0x2D, 0x2F, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0x5E, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xBC, 0xBD, 0xBE, 0xBF, 0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0xE4, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xC5, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xC6, 0xC7, 0xC8, 0xC9, 0xCA, 0xCB,
0xCC, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xCD, 0xCE, 0xCF, 0xD0, 0xD1, 0xD2,
0xD3, 0xE5, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xD4, 0xD5, 0xD6, 0xE3, 0xD7, 0xD8,
0xA9, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF, 0xE0, 0xE1, 0xE2, 0xD9, 0x5B, 0x5C, 0x5D, 0xE6, 0xE7,
0xF1, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED,
0xBB, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xEE, 0xEF, 0xF0, 0xFC, 0xF2, 0xF3,
0xFE, 0xF4, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0xFA,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xFB, 0x7B, 0xFD, 0x7D, 0xFF, 0x7E,
};
#endif /* POSIX-BC */
#if '^' == 176 /* if defined(??) (OS/400?) 037 */
unsigned char PL_utf2e[] = { /* UTF-8-mod to EBCDIC (IBM-037) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xBA, 0xE0, 0xBB, 0xB0, 0x6D,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x4F, 0xD0, 0xA1, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xFF,
0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56,
0x57, 0x58, 0x59, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x70, 0x71, 0x72, 0x73,
0x74, 0x75, 0x76, 0x77, 0x78, 0x80, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F, 0x90, 0x9A, 0x9B, 0x9C,
0x9D, 0x9E, 0x9F, 0xA0, 0xAA, 0xAB, 0xAC, 0xAE, 0xAF, 0x5F, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6,
0xB7, 0xB8, 0xB9, 0xAD, 0xBD, 0xBC, 0xBE, 0xBF, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF, 0xDA, 0xDB,
0xDC, 0xDD, 0xDE, 0xDF, 0xE1, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE,
};
unsigned char PL_e2utf[] = { /* EBCDIC (IBM-037) to UTF-8-mod */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x85, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x0A, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF, 0xB0, 0xB1, 0xB2, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0xD9,
0x2D, 0x2F, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0xBB, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xBC, 0xBD, 0xBE, 0xBF, 0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xC5, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xC6, 0xC7, 0xC8, 0xC9, 0xCA, 0xCB,
0xCC, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xCD, 0xCE, 0xCF, 0xD0, 0xD1, 0xD2,
0xD3, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xD4, 0xD5, 0xD6, 0xE3, 0xD7, 0xD8,
0x5E, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF, 0xE0, 0xE1, 0xE2, 0x5B, 0x5D, 0xE5, 0xE4, 0xE6, 0xE7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xEE, 0xEF, 0xF0, 0xF1, 0xF2, 0xF3,
0x5C, 0xF4, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0xFA,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF, 0x9F,
};
#endif /* 037 */
/* These tables moved from perl.h and converted to hex.
They map platfrom code page from/to bottom 256 codes of Unicode (i.e. iso-8859-1).
*/
#if '^' == 95 /* if defined(__MVS__) || defined(??) (VM/ESA?) 1047 */
EXTCONST unsigned char PL_a2e[] = { /* ASCII (iso-8859-1) to EBCDIC (IBM-1047) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x15, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x4F, 0xD0, 0xA1, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xFF,
0x41, 0xAA, 0x4A, 0xB1, 0x9F, 0xB2, 0x6A, 0xB5, 0xBB, 0xB4, 0x9A, 0x8A, 0xB0, 0xCA, 0xAF, 0xBC,
0x90, 0x8F, 0xEA, 0xFA, 0xBE, 0xA0, 0xB6, 0xB3, 0x9D, 0xDA, 0x9B, 0x8B, 0xB7, 0xB8, 0xB9, 0xAB,
0x64, 0x65, 0x62, 0x66, 0x63, 0x67, 0x9E, 0x68, 0x74, 0x71, 0x72, 0x73, 0x78, 0x75, 0x76, 0x77,
0xAC, 0x69, 0xED, 0xEE, 0xEB, 0xEF, 0xEC, 0xBF, 0x80, 0xFD, 0xFE, 0xFB, 0xFC, 0xBA, 0xAE, 0x59,
0x44, 0x45, 0x42, 0x46, 0x43, 0x47, 0x9C, 0x48, 0x54, 0x51, 0x52, 0x53, 0x58, 0x55, 0x56, 0x57,
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (IBM-1047) to ASCII (iso-8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xE2, 0xE4, 0xE0, 0xE1, 0xE3, 0xE5, 0xE7, 0xF1, 0xA2, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xE9, 0xEA, 0xEB, 0xE8, 0xED, 0xEE, 0xEF, 0xEC, 0xDF, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,
0x2D, 0x2F, 0xC2, 0xC4, 0xC0, 0xC1, 0xC3, 0xC5, 0xC7, 0xD1, 0xA6, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xF8, 0xC9, 0xCA, 0xCB, 0xC8, 0xCD, 0xCE, 0xCF, 0xCC, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xD8, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xAB, 0xBB, 0xF0, 0xFD, 0xFE, 0xB1,
0xB0, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xAA, 0xBA, 0xE6, 0xB8, 0xC6, 0xA4,
0xB5, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xA1, 0xBF, 0xD0, 0x5B, 0xDE, 0xAE,
0xAC, 0xA3, 0xA5, 0xB7, 0xA9, 0xA7, 0xB6, 0xBC, 0xBD, 0xBE, 0xDD, 0xA8, 0xAF, 0x5D, 0xB4, 0xD7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xAD, 0xF4, 0xF6, 0xF2, 0xF3, 0xF5,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xB9, 0xFB, 0xFC, 0xF9, 0xFA, 0xFF,
0x5C, 0xF7, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xB2, 0xD4, 0xD6, 0xD2, 0xD3, 0xD5,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0xDB, 0xDC, 0xD9, 0xDA, 0x9F
};
#endif /* 1047 */
#if '^' == 106 /* if defined(_OSD_POSIX) POSIX-BC */
EXTCONST unsigned char PL_a2e[] = { /* ASCII (ISO8859-1) to EBCDIC (POSIX-BC) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x15, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xBB, 0xBC, 0xBD, 0x6A, 0x6D,
0x4A, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xFB, 0x4F, 0xFD, 0xFF, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0x5F,
0x41, 0xAA, 0xB0, 0xB1, 0x9F, 0xB2, 0xD0, 0xB5, 0x79, 0xB4, 0x9A, 0x8A, 0xBA, 0xCA, 0xAF, 0xA1,
0x90, 0x8F, 0xEA, 0xFA, 0xBE, 0xA0, 0xB6, 0xB3, 0x9D, 0xDA, 0x9B, 0x8B, 0xB7, 0xB8, 0xB9, 0xAB,
0x64, 0x65, 0x62, 0x66, 0x63, 0x67, 0x9E, 0x68, 0x74, 0x71, 0x72, 0x73, 0x78, 0x75, 0x76, 0x77,
0xAC, 0x69, 0xED, 0xEE, 0xEB, 0xEF, 0xEC, 0xBF, 0x80, 0xE0, 0xFE, 0xDD, 0xFC, 0xAD, 0xAE, 0x59,
0x44, 0x45, 0x42, 0x46, 0x43, 0x47, 0x9C, 0x48, 0x54, 0x51, 0x52, 0x53, 0x58, 0x55, 0x56, 0x57,
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xC0, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (POSIX-BC) to ASCII (ISO8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xE2, 0xE4, 0xE0, 0xE1, 0xE3, 0xE5, 0xE7, 0xF1, 0x60, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xE9, 0xEA, 0xEB, 0xE8, 0xED, 0xEE, 0xEF, 0xEC, 0xDF, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x9F,
0x2D, 0x2F, 0xC2, 0xC4, 0xC0, 0xC1, 0xC3, 0xC5, 0xC7, 0xD1, 0x5E, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xF8, 0xC9, 0xCA, 0xCB, 0xC8, 0xCD, 0xCE, 0xCF, 0xCC, 0xA8, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xD8, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xAB, 0xBB, 0xF0, 0xFD, 0xFE, 0xB1,
0xB0, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xAA, 0xBA, 0xE6, 0xB8, 0xC6, 0xA4,
0xB5, 0xAF, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xA1, 0xBF, 0xD0, 0xDD, 0xDE, 0xAE,
0xA2, 0xA3, 0xA5, 0xB7, 0xA9, 0xA7, 0xB6, 0xBC, 0xBD, 0xBE, 0xAC, 0x5B, 0x5C, 0x5D, 0xB4, 0xD7,
0xF9, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xAD, 0xF4, 0xF6, 0xF2, 0xF3, 0xF5,
0xA6, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xB9, 0xFB, 0xFC, 0xDB, 0xFA, 0xFF,
0xD9, 0xF7, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xB2, 0xD4, 0xD6, 0xD2, 0xD3, 0xD5,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0x7B, 0xDC, 0x7D, 0xDA, 0x7E
};
#endif /* POSIX-BC */
#if '^' == 176 /* if defined(??) (OS/400?) 037 */
EXTCONST unsigned char PL_a2e[] = { /* ASCII (ISO8859-1) to EBCDIC (IBM-037) */
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xBA, 0xE0, 0xBB, 0xB0, 0x6D,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x4F, 0xD0, 0xA1, 0x07,
0x20, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xFF,
0x41, 0xAA, 0x4A, 0xB1, 0x9F, 0xB2, 0x6A, 0xB5, 0xBD, 0xB4, 0x9A, 0x8A, 0x5F, 0xCA, 0xAF, 0xBC,
0x90, 0x8F, 0xEA, 0xFA, 0xBE, 0xA0, 0xB6, 0xB3, 0x9D, 0xDA, 0x9B, 0x8B, 0xB7, 0xB8, 0xB9, 0xAB,
0x64, 0x65, 0x62, 0x66, 0x63, 0x67, 0x9E, 0x68, 0x74, 0x71, 0x72, 0x73, 0x78, 0x75, 0x76, 0x77,
0xAC, 0x69, 0xED, 0xEE, 0xEB, 0xEF, 0xEC, 0xBF, 0x80, 0xFD, 0xFE, 0xFB, 0xFC, 0xAD, 0xAE, 0x59,
0x44, 0x45, 0x42, 0x46, 0x43, 0x47, 0x9C, 0x48, 0x54, 0x51, 0x52, 0x53, 0x58, 0x55, 0x56, 0x57,
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (IBM-037) to ASCII (ISO8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x85, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0x80, 0x81, 0x82, 0x83, 0x84, 0x0A, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xE2, 0xE4, 0xE0, 0xE1, 0xE3, 0xE5, 0xE7, 0xF1, 0xA2, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xE9, 0xEA, 0xEB, 0xE8, 0xED, 0xEE, 0xEF, 0xEC, 0xDF, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0xAC,
0x2D, 0x2F, 0xC2, 0xC4, 0xC0, 0xC1, 0xC3, 0xC5, 0xC7, 0xD1, 0xA6, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xF8, 0xC9, 0xCA, 0xCB, 0xC8, 0xCD, 0xCE, 0xCF, 0xCC, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xD8, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xAB, 0xBB, 0xF0, 0xFD, 0xFE, 0xB1,
0xB0, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xAA, 0xBA, 0xE6, 0xB8, 0xC6, 0xA4,
0xB5, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xA1, 0xBF, 0xD0, 0xDD, 0xDE, 0xAE,
0x5E, 0xA3, 0xA5, 0xB7, 0xA9, 0xA7, 0xB6, 0xBC, 0xBD, 0xBE, 0x5B, 0x5D, 0xAF, 0xA8, 0xB4, 0xD7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xAD, 0xF4, 0xF6, 0xF2, 0xF3, 0xF5,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xB9, 0xFB, 0xFC, 0xF9, 0xFA, 0xFF,
0x5C, 0xF7, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xB2, 0xD4, 0xD6, 0xD2, 0xD3, 0xD5,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0xDB, 0xDC, 0xD9, 0xDA, 0x9F
};
#endif /* 037 */
#else
EXTCONST unsigned char PL_utf8skip[];
EXTCONST unsigned char PL_e2utf[];
EXTCONST unsigned char PL_utf2e[];
EXTCONST unsigned char PL_e2a[];
EXTCONST unsigned char PL_a2e[];
#endif
END_EXTERN_C
#define UTF8SKIP(s) PL_utf8skip[*(const U8*)s]
/* EBCDIC-happy ways of converting native code to UTF-8 */
/* Native to iso-8859-1 */
#define NATIVE_TO_ASCII(ch) PL_e2a[(U8)(ch)]
#define ASCII_TO_NATIVE(ch) PL_a2e[(U8)(ch)]
/* Transform after encoding */
#define NATIVE_TO_UTF(ch) PL_e2utf[(U8)(ch)]
#define UTF_TO_NATIVE(ch) PL_utf2e[(U8)(ch)]
/* Transform in wide UV char space */
#define NATIVE_TO_UNI(ch) (((ch) > 255) ? (ch) : NATIVE_TO_ASCII(ch))
#define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
/* Transform in invariant..byte space */
#define NATIVE_TO_NEED(enc,ch) ((enc) ? UTF_TO_NATIVE(NATIVE_TO_ASCII(ch)) : (ch))
#define ASCII_TO_NEED(enc,ch) ((enc) ? UTF_TO_NATIVE(ch) : ASCII_TO_NATIVE(ch))
/*
* Note: we should try and be careful never to call the isXXX_utf8() functions
* unless we're pretty sure we've seen the beginning of a UTF-EBCDIC character
* Otherwise we risk loading in the heavy-duty SWASHINIT and SWASHGET routines
* unnecessarily.
*/
#define isIDFIRST_lazy_if(p,c) ((IN_BYTES || (!c || UTF8_IS_INVARIANT(*p))) \
? isIDFIRST(*(p)) \
: isIDFIRST_utf8((const U8*)p))
#define isALNUM_lazy_if(p,c) ((IN_BYTES || (!c || UTF8_IS_INVARIANT(*p))) \
? isALNUM(*(p)) \
: isALNUM_utf8((const U8*)p))
/*
The following table is adapted from tr16, it shows UTF-8-mod encoding of Unicode code points.
Unicode Bit pattern 1st Byte 2nd Byte 3rd Byte 4th Byte 5th Byte 6th Byte 7th byte
U+0000..U+007F 000000000xxxxxxx 0xxxxxxx
U+0080..U+009F 00000000100xxxxx 100xxxxx
U+00A0..U+00FF 00000000yyyxxxxx 11000yyy 101xxxxx
U+00A0..U+03FF 000000yyyyyxxxxx 110yyyyy 101xxxxx
U+0400..U+3FFF 00zzzzyyyyyxxxxx 1110zzzz 101yyyyy 101xxxxx
U+4000..U+3FFFF 0wwwzzzzzyyyyyxxxxx 11110www 101zzzzz 101yyyyy 101xxxxx
U+40000..U+3FFFFF 0vvwwwwwzzzzzyyyyyxxxxx 111110vv 101wwwww 101zzzzz 101yyyyy 101xxxxx
U+400000..U+3FFFFFF 0uvvvvvwwwwwzzzzzyyyyyxxxxx 1111110u 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
U+4000000..U+7FFFFFFF 0tuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 1111111t 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
Note: The UTF-8-Mod transformation is valid for UCS-4 values X'0' to
X'7FFFFFFF' (the full extent of ISO/IEC 10646 coding space).
*/
#define UNISKIP(uv) ( (uv) < 0xA0 ? 1 : \
(uv) < 0x400 ? 2 : \
(uv) < 0x4000 ? 3 : \
(uv) < 0x40000 ? 4 : \
(uv) < 0x400000 ? 5 : \
(uv) < 0x4000000 ? 6 : 7 )
#define UNI_IS_INVARIANT(c) ((c) < 0xA0)
/* UTF-EBCDIC sematic macros - transform back into UTF-8-Mod and then compare */
#define NATIVE_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_ASCII(c))
#define UTF8_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_UTF(c))
#define UTF8_IS_START(c) (NATIVE_TO_UTF(c) >= 0xA0 && (NATIVE_TO_UTF(c) & 0xE0) != 0xA0)
#define UTF8_IS_CONTINUATION(c) ((NATIVE_TO_UTF(c) & 0xE0) == 0xA0)
#define UTF8_IS_CONTINUED(c) (NATIVE_TO_UTF(c) >= 0xA0)
#define UTF8_IS_DOWNGRADEABLE_START(c) (NATIVE_TO_UTF(c) >= 0xA0 && (NATIVE_TO_UTF(c) & 0xF8) == 0xC0)
#define UTF_START_MARK(len) ((len > 7) ? 0xFF : (0xFE << (7-len)))
#define UTF_START_MASK(len) ((len >= 6) ? 0x01 : (0x1F >> (len-2)))
#define UTF_CONTINUATION_MARK 0xA0
#define UTF_CONTINUATION_MASK ((U8)0x1f)
#define UTF_ACCUMULATION_SHIFT 5
#define UTF8_ACCUMULATE(old, new) (((old) << UTF_ACCUMULATION_SHIFT)|(NATIVE_TO_UTF(new) & UTF_CONTINUATION_MASK))
/* UTF-EBCDIC encode a downgradeable value */
#define UTF8_EIGHT_BIT_HI(c) UTF_TO_NATIVE((((U8)(c))>>UTF_ACCUMULATION_SHIFT)|UTF_START_MARK(2))
#define UTF8_EIGHT_BIT_LO(c) UTF_TO_NATIVE(((((U8)(c)))&UTF_CONTINUATION_MASK)|UTF_CONTINUATION_MARK)
--- NEW FILE: regcomp.c ---
/* regcomp.c
*/
/*
* "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
*/
/* This file contains functions for compiling a regular expression. See
* also regexec.c which funnily enough, contains functions for executing
* a regular expression.
*
* This file is also copied at build time to ext/re/re_comp.c, where
* it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
* This causes the main functions to be compiled under new names and with
* debugging support added, which makes "use re 'debug'" work.
*/
/* NOTE: this is derived from Henry Spencer's regexp code, and should not
* confused with the original package (see point 3 below). Thanks, Henry!
[...5165 lines suppressed...]
}
if (op == CURLYX || op == OPEN)
l++;
else if (op == WHILEM)
l--;
}
return node;
}
#endif /* DEBUGGING */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: makedef.pl ---
#
# Create the export list for perl.
#
# Needed by WIN32 and OS/2 for creating perl.dll,
# and by AIX for creating libperl.a when -Dusershrplib is in effect,
# and by MacOS Classic.
#
# reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h
# On OS/2 reads miniperl.map and the previous version of perl5.def as well
my $PLATFORM;
my $CCTYPE;
while (@ARGV) {
my $flag = shift;
if ($flag =~ s/^CC_FLAGS=/ /) {
for my $fflag ($flag =~ /(?:^|\s)-D(\S+)/g) {
$fflag .= '=1' unless $fflag =~ /^(\w+)=/;
$define{$1} = $2 if $fflag =~ /^(\w+)=(.+)$/;
[...1456 lines suppressed...]
# extra globals not included above.
Perl_cxinc
perl_alloc
perl_alloc_using
perl_clone
perl_clone_using
perl_construct
perl_destruct
perl_free
perl_parse
perl_run
# Oddities from PerlIO
PerlIO_binmode
PerlIO_getpos
PerlIO_init
PerlIO_setpos
PerlIO_sprintf
PerlIO_sv_dup
PerlIO_tmpfile
PerlIO_vsprintf
--- NEW FILE: myconfig.SH ---
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find the perl config.sh file produced by Configure";
exit 1
fi
. $TOP/config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting myconfig (with variable substitutions)"
$spitshell >myconfig <<!GROK!THIS!
$startsh
# This script is designed to provide a handy summary of the configuration
# information being used to build perl. This is especially useful if you
# are requesting help from comp.lang.perl.misc on usenet or via mail.
# Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm.
cat <<'!NO!SUBS!'
Summary of my $package (revision $revision $version_patchlevel_string) configuration:
Platform:
osname=$osname, osvers=$osvers, archname=$archname
uname='$myuname'
config_args='$config_args'
hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads usemultiplicity=$usemultiplicity
useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles usesocks=$usesocks
use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble
usemymalloc=$usemymalloc, bincompat5005=undef
Compiler:
cc='$cc', ccflags ='$ccflags',
optimize='$optimize',
cppflags='$cppflags'
ccversion='$ccversion', gccversion='$gccversion', gccosandvers='$gccosandvers'
intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize, byteorder=$byteorder
d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize
ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize
alignbytes=$alignbytes, prototype=$prototype
Linker and Libraries:
ld='$ld', ldflags ='$ldflags'
libpth=$libpth
libs=$libs
perllibs=$perllibs
libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl
gnulibc_version='$gnulibc_version'
Dynamic Linking:
dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags'
cccdlflags='$cccdlflags', lddlflags='$lddlflags'
!NO!SUBS!
!GROK!THIS!
chmod 755 myconfig
$eunicefix myconfig
--- NEW FILE: globals.c ---
/* globals.c
*
* Copyright (C) 1995, 1999, 2000, 2001, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "For the rest, they shall represent the other Free Peoples of the World:
* Elves, Dwarves, and Men." --Elrond
*/
/* This file exists to #include "perl.h" _ONCE_ with
* PERL_IN_GLOBALS_C defined. That causes various global varaiables
* in perl.h and other files it includes to be _defined_ (and initialized)
* rather than just declared.
*
* There is a #include "perlapi.h" which makes use of the fact
* that the object file created from this file will be included by linker
* (to resolve global variables). perlapi.h mention various other "API"
* functions not used by perl itself, but the functions get
* pulled into the perl executable via the refrerence here.
*
* Two printf() like functions have also found their way here.
* Most likely by analogy to the API scheme above (as perl doesn't
* use them) but they probably belong elsewhere the obvious place
* being in perlio.c
*
*/
#include "INTERN.h"
#define PERL_IN_GLOBALS_C
#include "perl.h"
int
Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
{
dTHXs;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(stream, format, arglist);
}
int
Perl_printf_nocontext(const char *format, ...)
{
dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
}
#include "perlapi.h" /* bring in PL_force_link_funcs */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.mint ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.mint - Perl version 5 on Atari MiNT
=head1 DESCRIPTION
There is a binary version of perl available from the FreeMiNT project
http://freemint.de/ You may wish to use this instead of trying to
compile yourself.
B<The following advice is from perl 5.004_02 and is probably rather
out of date.>
If you want to build perl yourself on MiNT (or maybe on an Atari without
MiNT) you may want to accept some advice from somebody who already did it...
There was a perl port for Atari ST done by ++jrb bammi at cadence.com.
This port tried very hard to build on non-MiNT-systems. For the
sake of efficiency I've left this way. Yet, I haven't removed bammi's
patches but left them intact. Unfortunately some of the files that
bammi contributed to the perl distribution seem to have vanished?
So, how can you distinguish my patches from bammi's patches? All of
bammi's stuff is embedded in "#ifdef atarist" preprocessor macros.
My MiNT port uses "#ifdef __MINT__" instead (and unconditionally
undefines "atarist". If you want to continue on bammi's port, all
you have to do is to swap the "-D" and "-U" switches for "__MINT__"
and "atarist" in the variable ccflags.
However, I think that my version will still run on non-MiNT-systems
provided that the user has a Eunuchs-like environment (i.e. the
standard envariables like $PATH, $HOME, ... are set, there is a
POSIX compliant shell in /bin/sh, and...)
=head1 Known problems with Perl on MiNT
The problems you may encounter when building perl on your machine
are most probably due to deficiencies in MiNT resp. the Atari
platform in general.
First of all, if you have less than 8 MB of RAM you shouldn't
even try to build Perl yourself. Better grab a binary pre-compiled
version somewhere. Even if you have more memory you should take
some care. Try to run in a fresh environment (without memory
fragmented too much) with as few daemons, accessories, xcontrol
modules etc. as possible. If you run some AES you should
consider to start a console based environment instead.
A problem has been reported with sed. Sed is used to create
some configuration files based on the answers you have given
to the Configure script. Unfortunately the Perl Configure script
shows sed on MiNT its limits. I have sed 2.05 with a stacksize
of 64k and I have encountered no problems. If sed crashes
during your configuration process you should first try to
augment sed's stacksize:
fixstk 64k /usr/bin/sed
(or similar). If it still doesn't help you may have a look
which other versions of sed are installed on your system.
If you have a KGMD 1.0 installation you will find three
in /usr/bin. Have a look there.
Perl has some "mammut" C files. If gcc reports "internal
compiler error: program cc1 got fatal signal 10" this is very
likely due to a stack overflow in program cc1. Find cc1
and fix its stack. I have made good experiences with
fixstk 2 cc1
This doesn't establish a stack of 2 Bytes only as you might
think. It really reserves one half of the available memory
for cc1's stack. A setting of 1 would reserve the entire
memory for cc1, 3 would reserve three fourths. You will have
to find out the value that suits to your system yourself.
To find out the location of the program "cc1" simply type
`gcc --print-prog-name cc1' at your shell prompt.
Now run make (maybe "make -k"). If you get a fatal signal 10
increase cc1's stacksize, if you run out of memory you should
either decrease the stacksize or follow some more hints:
Perl's building process is very handy on machines with a lot
of virtual memory but may result in a disaster if you are short
of memory. If gcc fails to compile many source files you should
reduce the optimization. Grep for "optimize" in the file
config.sh and change the flags.
If only several huge files cause problems (actually it is not a
matter of the file size resp. the amount of code but depends on
the size of the individual functions) it is useful to bypass
the make program and compile these files directly from the
command line. For example if you got something like the
following from make:
CCCMD = gcc -DPERL_CORE ....
...
...: virtual memory exhausted
you should hack into the shell:
gcc -DPERL_CORE ... toke.c
Please note that you have to add the name of the source file
(here toke.c) at the end.
If none of this helps, you're helpless. Wait for a binary
release. If you have succeeded you may encounter another problem
at the linking process. If gcc complains that it can't find
some libraries within the perl distribution you probably have
an old linker. If it complains for example about "file not
found for xxx.olb" you should cd into the directory in
question and
ln -s libxxx.a xxx.olb
This will fix the problem.
This version (5.00402) of perl has passed most of the tests on my system:
Failed Test Status Wstat Total Fail Failed List of failed
------------------------------------------------------------------------------
io/pipe.t 10 2 20.00% 7, 9
io/tell.t 13 1 7.69% 12
lib/complex.t 762 13 1.71% 84-85, 248-251, 257, 272-273,
371, 380, 419-420
lib/io_pipe.t 10 1 10.00% 9
lib/io_tell.t 13 1 7.69% 12
op/magic.t 30 2 6.67% 29-30
Failed 6/152 test scripts, 96.05% okay. 20/4359 subtests failed, 99.54% okay.
Pipes always cause problems with MiNT, it's actually a surprise that
most of the tests did work. I've got no idea why the "tell" test failed,
this shouldn't mean too big a problem however.
Most of the failures of lib/complex seem to be harmless, actually errors
far right to the decimal point... Two failures seem to be serious:
The sign of the results is reversed. I would say that this is due
to minor bugs in the portable math lib that I compiled perl with.
I haven't bothered very much to find the reason for the failures
with op/magic.t and op/stat.t. Maybe you'll find it out.
##########################################################################
Another possible problem may arise from the implementation of the "pwd"
command. It happened to add a carriage return and newline to its output
no matter what the setting of $UNIXMODE is. This is quite annoying since many
library modules for perl take the output of pwd, chop off the
trailing newline character and then expect to see a valid path in
that. But the carriage return (last but second character!) isn't
chopped off. You can either try to patch all library modules (at
the price of performance for the extra transformation) or you can
use my version of pwd that doesn't suffer from this deficiency.
The fixed implementation is in the mint subdirectory. Running
"Configure" will attempt to build and install it if necessary
(hints/mint.sh will do this work) but you can build and install it
explicitly by:
cd mint
make install
This is the fastest solution.
Just in case you want to go the hard way: perl won't even build with a
broken pwd! You will have to fix the library modules
(ext/POSIX/POSIX.pm, lib/Cwd.pm, lib/pwd.pl) at last after building
miniperl.
A major nuisance of current MiNTLib versions is the implementation
of system() which is far from being POSIX compliant. A real system()
should fork and then exec /bin/sh with its argument as a command
line to the shell. The MiNTLib system() however doesn't expect
that every user has a POSIX shell in /bin/sh. It tries to work
around the problem by forking and exec'ing the first token in its argument
string. To get a little bit of compliance to POSIX system() it
tries to handle at least redirection ("<" or ">") on its own
behalf.
This isn't a good idea since many programs expect that they can
pass a command line to system() that exploits all features of a
POSIX shell. If you use the MiNTLib version of system() with
perl the Perl function system() will suffer from the same deficiencies.
You will find a fixed version of system() in the mint subdirectory.
You can easily insert this version into your system libc:
cd mint
make system.o
ar r /usr/lib/libc.a
ranlib /usr/lib/libc.a
If you are suspicious you should either back up your libc before
or extract the original system.o from your libc with
"ar x /usr/lib/libc.a system.o". You can then backup the system.o
module somewhere before you succeed.
Anything missing? Yep, I've almost forgotten...
No file in this distribution without a fine saying. Take this one:
"From a thief you should learn: (1) to work at night;
(2) if one cannot gain what one wants in one night to
try again the next night; (3) to love one's coworkers
just as thieves love each other; (4) to be willing to
risk one's life even for a little thing; (5) not to
attach too much value to things even though one has
risked one's life for them - just as a thief will resell
a stolen article for a fraction of its real value;
(6) to withstand all kinds of beatings and tortures
but to remain what you are; and (7) to believe your
work is worthwhile and not be willing to change it."
-- Rabbi Dov Baer, Maggid of Mezeritch
OK, this was my motto while working on Perl for MiNT, especially rule (1)...
Have fun with Perl!
=head1 AUTHOR
Guido Flohr
mailto:guido at FreeMiNT.de
--- NEW FILE: installperl ---
#!./perl
BEGIN {
require 5.004;
chdir '..' if !-d 'lib' and -d '../lib';
@INC = 'lib';
$ENV{PERL5LIB} = 'lib';
}
use strict;
my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $Is_Darwin,
$nonono, $dostrip, $versiononly, $silent, $verbose, $force,
$otherperls, $archname, $Is_NetWare, $nwinstall, $nopods);
use vars qw /$depth/;
BEGIN {
$Is_VMS = $^O eq 'VMS';
$Is_W32 = $^O eq 'MSWin32';
$Is_OS2 = $^O eq 'os2';
$Is_Cygwin = $^O eq 'cygwin';
$Is_Darwin = $^O eq 'darwin';
if ($Is_VMS) { eval 'use VMS::Filespec;' }
}
my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : '');
use File::Find;
use File::Compare;
use File::Copy ();
use File::Path ();
use ExtUtils::Packlist;
use Config;
use subs qw(unlink link chmod);
if ($Config{d_umask}) {
umask(022); # umasks like 077 aren't that useful for installations
}
$Is_NetWare = $Config{osname} eq 'NetWare';
if ($Is_NetWare) {
$Is_W32 = 0;
$scr_ext = '.pl';
}
# override the ones in the rest of the script
sub mkpath {
File::Path::mkpath(@_) unless $nonono;
}
my $mainperldir = "/usr/bin";
my $exe_ext = $Config{exe_ext};
# Allow ``make install PERLNAME=something_besides_perl'':
my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl';
# This is the base used for versioned names, like "perl5.6.0".
# It's separate because a common use of $PERLNAME is to install
# perl as "perl5", if that's used as base for versioned files you
# get "perl55.6.0".
my $perl_verbase = defined($ENV{PERLNAME_VERBASE})
? $ENV{PERLNAME_VERBASE}
: $perl;
my $dbg = '';
my $ndbg = '';
if ( $Is_VMS ) {
if ( defined $Config{usevmsdebug} ) {
if ( $Config{usevmsdebug} eq 'define' ) {
$dbg = 'dbg';
$ndbg = 'ndbg';
}
}
}
$otherperls = 1;
my $destdir = '';
while (@ARGV) {
$nonono = 1 if $ARGV[0] eq '-n';
$dostrip = 1 if $ARGV[0] eq '-s';
$versiononly = 1 if $ARGV[0] eq '-v';
$versiononly = 0 if $ARGV[0] eq '+v';
$silent = 1 if $ARGV[0] eq '-S';
$otherperls = 0 if $ARGV[0] eq '-o';
$force = 1 if $ARGV[0] eq '-f';
$verbose = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n';
$archname = 1 if $ARGV[0] eq '-A';
$nwinstall = 1 if $ARGV[0] eq '-netware';
$nopods = 1 if $ARGV[0] eq '-p';
$destdir = $1 if $ARGV[0] =~ /^-?-destdir=(.*)$/;
if ($ARGV[0] eq '-?' or $ARGV[0] =~ /^-?-h/) {
print <<"EOT";
Usage $0: [switches]
-n Don't actually run any commands; just print them.
-s Run strip on installed binaries.
-v Only install perl as a binary with the version number in the name.
(Override whatever config.sh says)
+v Install perl as "perl" and as a binary with the version number in
the name. (Override whatever config.sh says)
-S Silent mode.
-f Force installation (don't check if same version is there)
-o Skip checking for other copies of perl in your PATH.
-V Verbose mode.
-A Also install perl with the architecture's name in the perl binary's
name.
-p Don't install the pod files. [This will break use diagnostics;]
-netware Install correctly on a Netware server.
-destdir Prefix installation directories by this string.
EOT
exit;
}
shift;
}
$versiononly = 1 if $Config{versiononly} && !defined $versiononly;
my (@scripts, @tolink);
open SCRIPTS, "utils.lst" or die "Can't open utils.lst: $!";
while (<SCRIPTS>) {
next if /^#/;
s/\s*#\s*pod\s*=.*//; # install script regardless of pod location
next if /a2p/; # a2p is binary, to be installed separately
chomp;
if (/(\S*)\s*#\s*link\s*=\s*(\S*)/) {
push @scripts, $1;
push @tolink, [$1, $2];
} else {
push @scripts, $_;
}
}
close SCRIPTS;
if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
my @pods = $nopods ? () : (<pod/*.pod>, 'x2p/a2p.pod');
# Specify here any .pm files that are actually architecture-dependent.
# (Those included with XS extensions under ext/ are automatically
# added later.)
# Now that the default privlib has the full perl version number included,
# we no longer have to play the trick of sticking version-specific .pm
# files under the archlib directory.
my %archpms = (
Config => 1,
lib => 1,
Cwd => 1,
);
if ($^O eq 'dos') {
push(@scripts,'djgpp/fixpmain');
$archpms{config} = $archpms{filehand} = 1;
}
if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) {
push(@scripts, map("$_.exe", @scripts));
}
find(sub {
if ("$File::Find::dir/$_" =~ m{^ext\b(.*)/([^/]+)\.pm$}) {
my($path, $modname) = ($1,$2);
# strip trailing component first
$path =~ s{/[^/]*$}{};
# strip optional "/lib";
$path =~ s{/lib\b}{};
# strip any leading /
$path =~ s{^/}{};
# reconstitute canonical module name
$modname = "$path/$modname" if length $path;
# remember it
$archpms{$modname} = 1;
}
}, 'ext');
# print "[$_]\n" for sort keys %archpms;
my $ver = $Config{version};
my $release = substr($],0,3); # Not used currently.
my $patchlevel = substr($],3,2);
die "Patchlevel of perl ($patchlevel)",
"and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
if $patchlevel != $Config{'PERL_VERSION'};
# Fetch some frequently-used items from %Config
my $installbin = "$destdir$Config{installbin}";
my $installscript = "$destdir$Config{installscript}";
my $installprivlib = "$destdir$Config{installprivlib}";
my $installarchlib = "$destdir$Config{installarchlib}";
my $installsitelib = "$destdir$Config{installsitelib}";
my $installsitearch = "$destdir$Config{installsitearch}";
my $installman1dir = "$destdir$Config{installman1dir}";
my $man1ext = $Config{man1ext};
my $libperl = $Config{libperl};
# Shared library and dynamic loading suffixes.
my $so = $Config{so};
my $dlext = $Config{dlext};
my $dlsrc = $Config{dlsrc};
if ($^O eq 'os390') {
my $pwd;
chomp($pwd=`pwd`);
my $archlibexp = $Config{archlibexp};
my $usedl = $Config{usedl};
if ($usedl eq 'define') {
`./$^X -pibak -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`;
}
}
if ($nwinstall) {
# This is required only if we are installing on a NetWare server
$installscript = $Config{installnwscripts};
$installprivlib = $Config{installnwlib};
$installarchlib = $Config{installnwlib};
$installsitelib = $Config{installnwlib};
}
my $d_dosuid = $Config{d_dosuid};
my $binexp = $Config{binexp};
if ($Is_VMS) { # Hang in there until File::Spec hits the big time
foreach ( \$installbin, \$installscript, \$installprivlib,
\$installarchlib, \$installsitelib, \$installsitearch,
\$installman1dir ) {
$$_ = unixify($$_); $$_ =~ s:/$::;
}
}
# Do some quick sanity checks.
if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
$installbin || die "No installbin directory in config.sh\n";
-d $installbin || mkpath($installbin, $verbose, 0777);
-d $installbin || $nonono || die "$installbin is not a directory\n";
-w $installbin || $nonono || die "$installbin is not writable by you\n"
unless $installbin =~ m#^/afs/# || $nonono;
if (!$Is_NetWare) {
if (!$Is_VMS) {
-x 'perl' . $exe_ext || die "perl isn't executable!\n";
}
else {
-x $ndbg . 'perl' . $exe_ext || die "${ndbg}perl$exe_ext isn't executable!\n";
if ($dbg) {
-x $dbg . 'perl' . $exe_ext || die "${dbg}perl$exe_ext isn't executable!\n";
}
}
-x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
-f 't/rantests' || $Is_W32
|| warn "WARNING: You've never run 'make test' or",
" some tests failed! (Installing anyway.)\n";
} #if (!$Is_NetWare)
# This will be used to store the packlist
my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) {
my $perldll;
if ($Is_Cygwin) {
$perldll = $libperl;
my $v_e_r_s = $ver; $v_e_r_s =~ tr/./_/;
$perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/;
$perldll =~ s/^lib/cyg/;
if ($Config{useshrplib} eq 'true') {
# install ld2 and perlld as well
foreach ('ld2', 'perlld') {
safe_unlink("$installbin/$_");
copy("$_", "$installbin/$_");
chmod(0755, "$installbin/$_");
$packlist->{"$installbin/$_"} = { type => 'file' };
};
open (LD2, ">$installbin/ld2");
print LD2 <<SHELL;
#!/bin/sh
#
# ld wrapper, passes all args to perlld;
#
for trythis in $installbin/perl
do
if [ -x \$trythis ]
then
\$trythis $installbin/perlld "\$\@"
exit \$?
fi
done
# hard luck!
echo I see no perl executable around there
echo perl is required to build dynamic libraries
echo look if the path to perl in /bin/ld2 is correct
exit 1
SHELL
close LD2;
chmod(0755, "$installbin/ld2");
};
} else {
$perldll = 'perl58.' . $dlext;
}
if ($dlsrc ne "dl_none.xs") {
-f $perldll || die "No perl DLL built\n";
}
# Install the DLL
safe_unlink("$installbin/$perldll");
copy("$perldll", "$installbin/$perldll");
chmod(0755, "$installbin/$perldll");
$packlist->{"$installbin/$perldll"} = { type => 'file' };
} # if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin)
# First we install the version-numbered executables.
if ($Is_VMS) {
safe_unlink("$installbin/perl_setup.com");
copy("perl_setup.com", "$installbin/perl_setup.com");
chmod(0755, "$installbin/perl_setup.com");
safe_unlink("$installbin/$dbg$perl$exe_ext");
copy("$dbg$perl$exe_ext", "$installbin/$dbg$perl$exe_ext");
chmod(0755, "$installbin/$dbg$perl$exe_ext");
safe_unlink("$installbin/$dbg${perl}shr$exe_ext");
copy("$dbg${perl}shr$exe_ext", "$installbin/$dbg${perl}shr$exe_ext");
chmod(0755, "$installbin/$dbg${perl}shr$exe_ext");
if ($ndbg) {
safe_unlink("$installbin/$ndbg$perl$exe_ext");
copy("$ndbg$perl$exe_ext", "$installbin/$ndbg$perl$exe_ext");
chmod(0755, "$installbin/$ndbg$perl$exe_ext");
safe_unlink("$installbin/${dbg}a2p$exe_ext");
copy("x2p/${dbg}a2p$exe_ext", "$installbin/${dbg}a2p$exe_ext");
chmod(0755, "$installbin/${dbg}a2p$exe_ext");
}
}
elsif ($^O eq 'mpeix') {
# MPE lacks hard links and requires that executables with special
# capabilities reside in the MPE namespace.
safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath});
# Install the primary executable into the MPE namespace as perlpath.
copy("perl$exe_ext", $Config{perlpath});
chmod(0755, $Config{perlpath});
# Create a backup copy with the version number.
link($Config{perlpath}, "$installbin/perl$ver$exe_ext");
}
elsif ($^O ne 'dos') {
if (!$Is_NetWare) {
safe_unlink("$installbin/$perl_verbase$ver$exe_ext");
copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext");
strip("$installbin/$perl_verbase$ver$exe_ext");
chmod(0755, "$installbin/$perl_verbase$ver$exe_ext");
}
else {
# If installing onto a NetWare server
if ($nwinstall) {
# Copy perl.nlm, echo.nlm, type.nlm, a2p.nlm & cgi2perl.nlm
mkpath($Config{installnwsystem}, 1, 0777);
copy("netware\\".$ENV{'MAKE_TYPE'}."\\perl.nlm", $Config{installnwsystem});
copy("netware\\testnlm\\echo\\echo.nlm", $Config{installnwsystem});
copy("netware\\testnlm\\type\\type.nlm", $Config{installnwsystem});
copy("x2p\\a2p.nlm", $Config{installnwsystem});
chmod(0755, "$Config{installnwsystem}\\perl.nlm");
mkpath($Config{installnwlcgi}, 1, 0777);
copy("lib\\auto\\cgi2perl\\cgi2perl.nlm", $Config{installnwlcgi});
}
} #if (!$Is_NetWare)
}
else {
safe_unlink("$installbin/$perl.exe");
copy("perl.exe", "$installbin/$perl.exe");
}
safe_unlink("$installbin/s$perl_verbase$ver$exe_ext");
if ($d_dosuid) {
copy("suidperl$exe_ext", "$installbin/s$perl_verbase$ver$exe_ext");
chmod(04711, "$installbin/s$perl_verbase$ver$exe_ext");
}
# Install library files.
my ($do_installarchlib, $do_installprivlib) = (0, 0);
mkpath($installprivlib, $verbose, 0777);
mkpath($installarchlib, $verbose, 0777);
mkpath($installsitelib, $verbose, 0777) if ($installsitelib);
mkpath($installsitearch, $verbose, 0777) if ($installsitearch);
if (chdir "lib") {
$do_installarchlib = ! samepath($installarchlib, '.');
$do_installprivlib = ! samepath($installprivlib, '.');
$do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/);
if ($do_installarchlib || $do_installprivlib) {
find(\&installlib, '.');
}
chdir ".." || die "Can't cd back to source directory: $!\n";
}
else {
warn "Can't cd to lib to install lib files: $!\n";
}
# Install header files and libraries.
mkpath("$installarchlib/CORE", $verbose, 0777);
my @corefiles;
if ($Is_VMS) { # We did core file selection during build
my $coredir = "lib/$Config{archname}/$ver/CORE";
$coredir =~ tr/./_/;
map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>;
}
else {
# [als] hard-coded 'libperl' name... not good!
@corefiles = <*.h *.inc libperl*.* perl*$Config{lib_ext}>;
# AIX needs perl.exp installed as well.
push(@corefiles,'perl.exp') if $^O eq 'aix';
if ($^O eq 'mpeix') {
# MPE needs mpeixish.h installed as well.
mkpath("$installarchlib/CORE/mpeix", $verbose, 0777);
push(@corefiles,'mpeix/mpeixish.h');
}
# If they have built sperl.o...
push(@corefiles,'sperl.o') if -f 'sperl.o';
}
foreach my $file (@corefiles) {
# HP-UX (at least) needs to maintain execute permissions
# on dynamically-loadable libraries. So we do it for all.
if (copy_if_diff($file,"$installarchlib/CORE/$file")) {
if ($file =~ /\.(\Q$so\E|\Q$dlext\E)$/) {
strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody|darwin)$/;
chmod(0555, "$installarchlib/CORE/$file");
} else {
chmod(0444, "$installarchlib/CORE/$file");
}
}
}
# Switch in the 5.005-threads versions of he threadsafe queue and semaphore
# modules if so needed.
if ($Config{use5005threads}) {
for my $m (qw(Queue Semaphore)) {
my $t = "$installprivlib/Thread/$m.pm";
unlink $t;
copy("ext/Thread/$m.pmx", $t);
chmod(0444, $t);
}
}
# Install main perl executables
# Make links to ordinary names if installbin directory isn't current directory.
if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS && ! $Is_NetWare) {
safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
if ($^O eq 'mpeix') {
# MPE doesn't support hard links, so use a symlink.
# We don't want another cloned copy.
symlink($Config{perlpath}, "$installbin/perl$exe_ext");
} elsif ($^O eq 'vos') {
# VOS doesn't support hard links, so use a symlink.
symlink("$installbin/$perl_verbase$ver$exe_ext",
"$installbin/$perl$exe_ext");
} else {
link("$installbin/$perl_verbase$ver$exe_ext",
"$installbin/$perl$exe_ext");
}
link("$installbin/$perl_verbase$ver$exe_ext",
"$installbin/suid$perl$exe_ext")
if $d_dosuid;
}
# For development purposes it can be very useful to have multiple perls
# build for different "architectures" (eg threading or not) simultaneously.
if ($archname && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
my $archperl = "$perl_verbase$ver-$Config{archname}$exe_ext";
safe_unlink("$installbin/$archperl");
if ($^O eq 'mpeix') {
# MPE doesn't support hard links, so use a symlink.
# We don't want another cloned copy.
symlink($Config{perlpath}, "$installbin/$archperl");
} elsif ($^O eq 'vos') {
# VOS doesn't support hard links, so use a symlink.
symlink("$installbin/$perl_verbase$ver$exe_ext",
"$installbin/$archperl");
} else {
link("$installbin/$perl_verbase$ver$exe_ext", "$installbin/$archperl");
}
}
# Offer to install perl in a "standard" location
my $mainperl_is_instperl = 0;
if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' &&
!$versiononly && !$nonono && !$Is_W32 && !$Is_NetWare && !$Is_VMS && -t STDIN && -t STDERR
&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
my($usrbinperl) = "$mainperldir/$perl$exe_ext";
my($instperl) = "$installbin/$perl$exe_ext";
my($expinstperl) = "$binexp/$perl$exe_ext";
# First make sure $usrbinperl is not already the same as the perl we
# just installed.
if (-x $usrbinperl) {
# Try to be clever about mainperl being a symbolic link
# to binexp/perl if binexp and installbin are different.
$mainperl_is_instperl =
samepath($usrbinperl, $instperl) ||
samepath($usrbinperl, $expinstperl) ||
(($binexp ne $installbin) &&
(-l $usrbinperl) &&
((readlink $usrbinperl) eq $expinstperl));
}
if (! $mainperl_is_instperl) {
unlink($usrbinperl);
( $Config{'d_link'} eq 'define' &&
eval { CORE::link $instperl, $usrbinperl } ) ||
eval { symlink $expinstperl, $usrbinperl } ||
copy($instperl, $usrbinperl);
$mainperl_is_instperl = 1;
}
}
# Make links to ordinary names if installbin directory isn't current directory.
if (!$Is_NetWare && $dbg eq '') {
if (! samepath($installbin, 'x2p')) {
my $base = 'a2p';
$base .= $ver if $versiononly;
safe_unlink("$installbin/$base$exe_ext");
copy("x2p/a2p$exe_ext", "$installbin/$base$exe_ext");
strip("$installbin/$base$exe_ext");
chmod(0755, "$installbin/$base$exe_ext");
}
}
# cppstdin is just a script, but it is architecture-dependent, so
# it can't safely be shared. Place it in $installbin.
# Note that Configure doesn't build cppstin if it isn't needed, so
# we skip this if cppstdin doesn't exist.
if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) {
safe_unlink("$installbin/cppstdin");
copy("cppstdin", "$installbin/cppstdin");
chmod(0755, "$installbin/cppstdin");
}
sub script_alias {
my ($installscript, $orig, $alias, $scr_ext) = @_;
safe_unlink("$installscript/$alias$scr_ext");
if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') {
copy("$installscript/$orig$scr_ext",
"$installscript/$alias$scr_ext");
} elsif ($^O eq 'vos') {
symlink("$installscript/$orig$scr_ext",
"$installscript/$alias$scr_ext");
} else {
link("$installscript/$orig$scr_ext",
"$installscript/$alias$scr_ext");
}
}
# Install scripts.
mkpath($installscript, $verbose, 0777);
if ($versiononly) {
for (@scripts) {
(my $base = $_) =~ s#.*/##;
$base .= $ver;
copy($_, "$installscript/$base");
chmod(0755, "$installscript/$base");
}
for (@tolink) {
my ($from, $to) = map { "$_$ver" } @$_;
(my $frbase = $from) =~ s#.*/##;
(my $tobase = $to) =~ s#.*/##;
script_alias($installscript, $frbase, $tobase, $scr_ext);
}
} else {
for (@scripts) {
(my $base = $_) =~ s#.*/##;
copy($_, "$installscript/$base");
chmod(0755, "$installscript/$base");
}
for (@tolink) {
my ($from, $to) = @$_;
(my $frbase = $from) =~ s#.*/##;
(my $tobase = $to) =~ s#.*/##;
script_alias($installscript, $frbase, $tobase, $scr_ext);
}
}
# Install pod pages. Where? I guess in $installprivlib/pod
# ($installprivlib/pods for cygwin).
my $pod = ($Is_Cygwin || $Is_Darwin || $Is_VMS) ? 'pods' : 'pod';
if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) {
mkpath("${installprivlib}/$pod", $verbose, 0777);
# If Perl 5.003's perldiag.pod is there, rename it.
if (open POD, "${installprivlib}/$pod/perldiag.pod") {
read POD, $_, 4000;
close POD;
# Some of Perl 5.003's diagnostic messages ended with periods.
if (/^=.*\.$/m) {
my ($from, $to) = ("${installprivlib}/$pod/perldiag.pod",
"${installprivlib}/$pod/perldiag-5.003.pod");
print " rename $from $to";
rename($from, $to)
or warn "Couldn't rename $from to $to: $!\n"
unless $nonono;
}
}
for (@pods) {
# $_ is a name like pod/perl.pod
(my $base = $_) =~ s#.*/##;
copy_if_diff($_, "${installprivlib}/$pod/${base}");
}
}
# Check to make sure there aren't other perls around in installer's
# path. This is probably UNIX-specific. Check all absolute directories
# in the path except for where public executables are supposed to live.
# Also skip $mainperl if the user opted to have it be a link to the
# installed perl.
if (!$versiononly && $otherperls) {
my ($path, @path);
my $dirsep = ($Is_OS2 || $Is_W32 || $Is_NetWare) ? ';' : ':' ;
($path = $ENV{"PATH"}) =~ s:\\:/:g ;
@path = split(/$dirsep/, $path);
if ($Is_VMS) {
my $i = 0;
while (exists $ENV{'DCL$PATH' . $i}) {
my $dir = unixpath($ENV{'DCL$PATH' . $i}); $dir =~ s-/$--;
push(@path,$dir);
}
}
my @otherperls;
my %otherperls;
for (@path) {
next unless m,^/,;
# Use &samepath here because some systems have other dirs linked
# to $mainperldir (like SunOS)
next if samepath($_, $binexp);
next if ($mainperl_is_instperl && samepath($_, $mainperldir));
my $otherperl = "$_/$perl$exe_ext";
next if $otherperls{$otherperl}++;
push(@otherperls, $otherperl)
if (-x $otherperl && ! -d $otherperl);
}
if (@otherperls) {
warn "\nWarning: $perl appears in your path in the following " .
"locations beyond where\nwe just installed it:\n";
for (@otherperls) {
warn " ", $_, "\n";
}
warn "\n";
}
}
$packlist->write() unless $nonono;
print " Installation complete\n" if $verbose;
exit 0;
###############################################################################
sub yn {
my($prompt) = @_;
my($answer);
my($default) = $prompt =~ m/\[([yn])\]\s*$/i;
print STDERR $prompt;
chop($answer = <STDIN>);
$answer = $default if $answer =~ m/^\s*$/;
($answer =~ m/^[yY]/);
}
sub unlink {
my(@names) = @_;
my($cnt) = 0;
return scalar(@names) if $Is_VMS;
foreach my $name (@names) {
next unless -e $name;
chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare);
print " unlink $name\n" if $verbose;
( CORE::unlink($name) and ++$cnt
or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
}
return $cnt;
}
sub safe_unlink {
return if $nonono or $Is_VMS;
my @names = @_;
foreach my $name (@names) {
next unless -e $name;
chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_NetWare);
print " unlink $name\n" if $verbose;
next if CORE::unlink($name);
warn "Couldn't unlink $name: $!\n";
if ($! =~ /busy/i) {
print " mv $name $name.old\n" if $verbose;
safe_rename($name, "$name.old")
or warn "Couldn't rename $name: $!\n";
}
}
}
sub safe_rename {
my($from,$to) = @_;
if (-f $to and not unlink($to)) {
my($i);
for ($i = 1; $i < 50; $i++) {
last if rename($to, "$to.$i");
}
warn("Cannot rename to `$to.$i': $!"), return 0
if $i >= 50; # Give up!
}
link($from,$to) || return 0;
unlink($from);
}
sub link {
my($from,$to) = @_;
my($success) = 0;
my $xfrom = $from;
$xfrom =~ s/^\Q$destdir\E// if $destdir;
my $xto = $to;
$xto =~ s/^\Q$destdir\E// if $destdir;
print $verbose ? " ln $xfrom $xto\n" : " $xto\n" unless $silent;
eval {
CORE::link($from, $to)
? $success++
: ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
? die "AFS" # okay inside eval {}
: die "Couldn't link $from to $to: $!\n"
unless $nonono;
$packlist->{$xto} = { from => $xfrom, type => 'link' };
};
if ($@) {
warn "Replacing link() with File::Copy::copy(): $@";
print $verbose ? " cp $from $xto\n" : " $xto\n" unless $silent;
print " creating new version of $xto\n"
if $Is_VMS and -e $to and !$silent;
unless ($nonono or File::Copy::copy($from, $to) and ++$success) {
# Might have been that F::C::c can't overwrite the target
warn "Couldn't copy $from to $to: $!\n"
unless -f $to and (chmod(0666, $to), unlink $to)
and File::Copy::copy($from, $to) and ++$success;
}
$packlist->{$xto} = { type => 'file' };
}
$success;
}
sub chmod {
my($mode,$name) = @_;
return if ($^O eq 'dos');
printf " chmod %o %s\n", $mode, $name if $verbose;
CORE::chmod($mode,$name)
|| warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name)
unless $nonono;
}
sub copy {
my($from,$to) = @_;
my $xto = $to;
$xto =~ s/^\Q$destdir\E// if $destdir;
print $verbose ? " cp $from $xto\n" : " $xto\n" unless $silent;
print " creating new version of $xto\n" if $Is_VMS and -e $to and !$silent;
unless ($nonono or File::Copy::copy($from, $to)) {
# Might have been that F::C::c can't overwrite the target
warn "Couldn't copy $from to $to: $!\n"
unless -f $to and (chmod(0666, $to), unlink $to)
and File::Copy::copy($from, $to);
}
$packlist->{$xto} = { type => 'file' };
}
sub samepath {
my($p1, $p2) = @_;
return (lc($p1) eq lc($p2)) if ($Is_W32 || $Is_NetWare);
if ($p1 ne $p2) {
my($dev1, $ino1, $dev2, $ino2);
($dev1, $ino1) = stat($p1);
($dev2, $ino2) = stat($p2);
($dev1 == $dev2 && $ino1 == $ino2);
}
else {
1;
}
}
sub installlib {
my $dir = $File::Find::dir;
$dir =~ s#^\.(?![^/])/?##;
local($depth) = $dir ? "lib/$dir" : "lib";
my $name = $_;
# Ignore version control directories.
if ($name =~ /^(?:CVS|RCS|SCCS|\.svn)\z/ and -d $name) {
$File::Find::prune = 1;
return;
}
# ignore patch backups, RCS files, emacs backup & temp files and the
# .exists files, .PL files, and test files.
return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} ||
$dir =~ m{/t(?:/|$)};
# XXX xsubpp back out of the list. prove now integrated. Out of order, so
# p4 will conflict on the next update to the following lines:
# ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp
# scripts in lib/ExtUtils, and the prove script in lib/Test/Harness
# (they're installed later with other utils)
return if $name =~ /^(?:cpan|instmodsh|prove)\z/;
# ignore the Makefiles
return if $name =~ /^makefile$/i;
# ignore the test extensions
return if $dir =~ m{ext/XS/(?:APItest|Typemap)/};
# ignore the demo files
return if $dir =~ /\bdemos?\b/;
# ignore READMEs, MANIFESTs, INSTALL docs, META.ymls and change logs.
# Changes.e2x and README.e2x are needed by enc2xs.
return if $name =~ m{^(?:README(?:\.\w+)?|MANIFEST|META\.yml|INSTALL)$} && $name ne 'README.e2x';
return if $name =~ m{^(?:TODO|BUGS|CREDITS)$}i;
return if $name =~ m{^change(?:s|log)(?:\.libnet)?$}i;
$name = "$dir/$name" if $dir ne '';
my $installlib = $installprivlib;
if ($dir =~ /^auto/ ||
($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
($name =~ /^(.*)\.(?:h|lib)$/i && ($Is_W32 || $Is_NetWare)) ||
$name eq 'Config_heavy.pl'
) {
$installlib = $installarchlib;
return unless $do_installarchlib;
} else {
return unless $do_installprivlib;
}
if (-f $_) {
if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) {
$installlib = $installprivlib;
#We're installing *.al and *.ix files into $installprivlib,
#but we have to delete old *.al and *.ix files from the 5.000
#distribution:
#This might not work because $archname might have changed.
unlink("$installarchlib/$name");
}
my $xname = "$installlib/$name";
$xname =~ s/^\Q$destdir\E// if $destdir;
$packlist->{$xname} = { type => 'file' };
if ($force || compare($_, "$installlib/$name") || $nonono) {
unlink("$installlib/$name");
mkpath("$installlib/$dir", $verbose, 0777);
# HP-UX (at least) needs to maintain execute permissions
# on dynamically-loaded libraries.
if ($Is_NetWare && !$nwinstall) {
# Don't copy .nlp,.nlm files, doesn't make sense on Windows and also
# if copied will give problems when building new extensions.
# Has to be copied if we are installing on a NetWare server and hence
# the check !$nwinstall
if (!(/\.(?:nlp|nlm|bs)$/)) {
copy_if_diff($_, "$installlib/$name")
and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
"$installlib/$name");
}
} else {
if (copy_if_diff($_, "$installlib/$name")) {
if ($name =~ /\.(so|$dlext)$/o) {
strip("-S", "$installlib/$name") if $^O =~ /^(rhapsody|darwin)$/;
chmod(0555, "$installlib/$name");
} else {
strip("-S", "$installlib/$name")
if ($name =~ /\.a$/o and $^O =~ /^(rhapsody|darwin)$/);
chmod(0444, "$installlib/$name");
}
}
} #if ($Is_NetWare)
}
}
}
# Copy $from to $to, only if $from is different than $to.
# Also preserve modification times for .a libraries.
# On some systems, if you do
# ranlib libperl.a
# cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
# and then try to link against the installed libperl.a, you might
# get an error message to the effect that the symbol table is older
# than the library.
# Return true if copying occurred.
sub copy_if_diff {
my($from,$to)=@_;
return 1 if (($^O eq 'VMS') && (-d $from));
my $xto = $to;
$xto =~ s/^\Q$destdir\E// if $destdir;
my $perlpodbadsymlink;
if ($from =~ m!^pod/perl[\w-]+\.pod$! &&
-l $from &&
! -e $from) {
# Some Linux implementations have problems traversing over
# multiple symlinks (when going over NFS?) and fail to read
# the symlink target. Combine this with the fact that some
# of the pod files (the perl$OS.pod) are symlinks (to ../README.$OS),
# and you end up with those pods not getting installed.
$perlpodbadsymlink = 1;
}
-f $from || $perlpodbadsymlink || warn "$0: $from not found";
$packlist->{$xto} = { type => 'file' };
if ($force || compare($from, $to) || $nonono) {
safe_unlink($to); # In case we don't have write permissions.
if ($nonono) {
$from = $depth . "/" . $from if $depth;
}
if ($perlpodbadsymlink && $from =~ m!^pod/perl(.+)\.pod$!) {
$from = "README.$1";
}
copy($from, $to);
# Restore timestamps if it's a .a library or for OS/2.
if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) {
my ($atime, $mtime) = (stat $from)[8,9];
utime $atime, $mtime, $to;
}
1;
}
}
sub strip
{
my(@args) = @_;
return unless $dostrip;
my @opts;
while (@args && $args[0] =~ /^(-\w+)$/) {
push @opts, shift @args;
}
foreach my $file (@args) {
if (-f $file) {
if ($verbose) {
print " strip " . join(' ', @opts);
print " " if (@opts);
print "$file\n";
}
system("strip", @opts, $file);
} else {
print "# file '$file' skipped\n" if $verbose;
}
}
}
--- NEW FILE: op.h ---
/* op.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* The fields of BASEOP are:
* op_next Pointer to next ppcode to execute after this one.
* (Top level pre-grafted op points to first op,
* but this is replaced when op is grafted in, when
* this op will point to the real next op, and the new
* parent takes over role of remembering starting op.)
* op_ppaddr Pointer to current ppcode's function.
* op_type The type of the operation.
* op_flags Flags common to all operations. See OPf_* below.
* op_private Flags peculiar to a particular operation (BUT,
* by default, set to the number of children until
* the operation is privatized by a check routine,
* which may or may not check number of children).
*/
#ifdef DEBUGGING_OPS
#define OPCODE opcode
#else
#define OPCODE U16
#endif
#ifdef BASEOP_DEFINITION
#define BASEOP BASEOP_DEFINITION
#else
#define BASEOP \
OP* op_next; \
OP* op_sibling; \
OP* (CPERLscope(*op_ppaddr))(pTHX); \
PADOFFSET op_targ; \
OPCODE op_type; \
U16 op_seq; \
U8 op_flags; \
U8 op_private;
#endif
#define OP_GIMME(op,dfl) \
(((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \
((op)->op_flags & OPf_WANT) == OPf_WANT_SCALAR ? G_SCALAR : \
((op)->op_flags & OPf_WANT) == OPf_WANT_LIST ? G_ARRAY : \
dfl)
/*
=head1 "Gimme" Values
=for apidoc Amn|U32|GIMME_V
The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_VOID>,
C<G_SCALAR> or C<G_ARRAY> for void, scalar or list context,
respectively.
=for apidoc Amn|U32|GIMME
A backward-compatible version of C<GIMME_V> which can only return
C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>.
Deprecated. Use C<GIMME_V> instead.
=cut
*/
#define GIMME_V OP_GIMME(PL_op, block_gimme())
/* Public flags */
#define OPf_WANT 3 /* Mask for "want" bits: */
#define OPf_WANT_VOID 1 /* Want nothing */
#define OPf_WANT_SCALAR 2 /* Want single value */
#define OPf_WANT_LIST 3 /* Want list of any length */
#define OPf_KIDS 4 /* There is a firstborn child. */
#define OPf_PARENS 8 /* This operator was parenthesized. */
/* (Or block needs explicit scope entry.) */
#define OPf_REF 16 /* Certified reference. */
/* (Return container, not containee). */
#define OPf_MOD 32 /* Will modify (lvalue). */
#define OPf_STACKED 64 /* Some arg is arriving on the stack. */
#define OPf_SPECIAL 128 /* Do something weird for this op: */
/* On local LVAL, don't init local value. */
/* On OP_SORT, subroutine is inlined. */
/* On OP_NOT, inversion was implicit. */
/* On OP_LEAVE, don't restore curpm. */
/* On truncate, we truncate filehandle */
/* On control verbs, we saw no label */
/* On flipflop, we saw ... instead of .. */
/* On UNOPs, saw bare parens, e.g. eof(). */
/* On OP_ENTERSUB || OP_NULL, saw a "do". */
/* On OP_EXISTS, treat av as av, not avhv. */
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
/* On OP_ENTERITER, loop var is per-thread */
/* On pushre, re is /\s+/ imp. by split " " */
/* On regcomp, "use re 'eval'" was in scope */
/* On OP_READLINE, was <$filehandle> */
/* On RV2[ACGHS]V, don't create GV--in
defined()*/
/* On OP_DBSTATE, indicates breakpoint
* (runtime property) */
/* On OP_AELEMFAST, indiciates pad var */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST OPf_WANT_LIST
#define OPf_KNOW OPf_WANT
#define GIMME \
(PL_op->op_flags & OPf_WANT \
? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \
? G_ARRAY \
: G_SCALAR) \
: dowantarray())
/* NOTE: OP_NEXTSTATE, OP_DBSTATE, and OP_SETSTATE (i.e. COPs) carry lower
* bits of PL_hints in op_private */
/* Private for lvalues */
#define OPpLVAL_INTRO 128 /* Lvalue must be localized or lvalue sub */
/* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */
#define OPpREFCOUNTED 64 /* op_targ carries a refcount */
/* Private for OP_AASSIGN */
#define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */
#define OPpASSIGN_HASH 32 /* Assigning to possible pseudohash. */
/* Private for OP_SASSIGN */
#define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */
/* Private for OP_MATCH and OP_SUBST{,CONST} */
#define OPpRUNTIME 64 /* Pattern coming in on the stack */
/* Private for OP_TRANS */
#define OPpTRANS_FROM_UTF 1
#define OPpTRANS_TO_UTF 2
#define OPpTRANS_IDENTICAL 4 /* right side is same as left */
#define OPpTRANS_SQUASH 8
#define OPpTRANS_DELETE 16
#define OPpTRANS_COMPLEMENT 32
#define OPpTRANS_GROWS 64
/* Private for OP_REPEAT */
#define OPpREPEAT_DOLIST 64 /* List replication. */
/* Private for OP_RV2GV, OP_RV2SV, OP_AELEM, OP_HELEM, OP_PADSV */
#define OPpDEREF (32|64) /* autovivify: Want ref to something: */
#define OPpDEREF_AV 32 /* Want ref to AV. */
#define OPpDEREF_HV 64 /* Want ref to HV. */
#define OPpDEREF_SV (32|64) /* Want ref to SV. */
/* OP_ENTERSUB only */
#define OPpENTERSUB_DB 16 /* Debug subroutine. */
#define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */
#define OPpENTERSUB_NOMOD 64 /* Immune to mod() for :attrlist. */
/* OP_RV2CV only */
#define OPpENTERSUB_AMPER 8 /* Used & form to call. */
#define OPpENTERSUB_NOPAREN 128 /* bare sub call (without parens) */
#define OPpENTERSUB_INARGS 4 /* Lval used as arg to a sub. */
/* OP_GV only */
#define OPpEARLY_CV 32 /* foo() called before sub foo was parsed */
/* OP_?ELEM only */
#define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */
/* OP_RV2?V, OP_GVSV, OP_ENTERITER only */
#define OPpOUR_INTRO 16 /* Variable was in an our() */
/* OP_RV2[AH]V, OP_PAD[AH]V, OP_[AH]ELEM */
#define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */
/* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */
/* Private for OPs with TARGLEX */
/* (lower bits may carry MAXARG) */
#define OPpTARGET_MY 16 /* Target is PADMY. */
/* Private for OP_ENTERITER and OP_ITER */
#define OPpITER_REVERSED 4 /* for (reverse ...) */
/* Private for OP_CONST */
#define OPpCONST_SHORTCIRCUIT 4 /* eg the constant 5 in (5 || foo) */
#define OPpCONST_STRICT 8 /* bearword subject to strict 'subs' */
#define OPpCONST_ENTERED 16 /* Has been entered as symbol. */
#define OPpCONST_ARYBASE 32 /* Was a $[ translated to constant. */
#define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */
#define OPpCONST_WARNING 128 /* Was a $^W translated to constant. */
/* Private for OP_FLIP/FLOP */
#define OPpFLIP_LINENUM 64 /* Range arg potentially a line num. */
/* Private for OP_LIST */
#define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */
/* Private for OP_DELETE */
#define OPpSLICE 64 /* Operating on a list of keys */
/* Private for OP_EXISTS */
#define OPpEXISTS_SUB 64 /* Checking for &sub, not {} or []. */
/* Private for OP_SORT */
#define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */
#define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */
#define OPpSORT_REVERSE 4 /* Reversed sort */
#define OPpSORT_INPLACE 8 /* sort in-place; eg @a = sort @a */
#define OPpSORT_DESCEND 16 /* Descending sort */
/* Private for OP_THREADSV */
#define OPpDONE_SVREF 64 /* Been through newSVREF once */
/* Private for OP_OPEN and OP_BACKTICK */
#define OPpOPEN_IN_RAW 16 /* binmode(F,":raw") on input fh */
#define OPpOPEN_IN_CRLF 32 /* binmode(F,":crlf") on input fh */
#define OPpOPEN_OUT_RAW 64 /* binmode(F,":raw") on output fh */
#define OPpOPEN_OUT_CRLF 128 /* binmode(F,":crlf") on output fh */
/* Private for OP_EXIT, HUSH also for OP_DIE */
#define OPpHUSH_VMSISH 64 /* hush DCL exit msg vmsish mode*/
#define OPpEXIT_VMSISH 128 /* exit(0) vs. exit(1) vmsish mode*/
/* Private of OP_FTXXX */
#define OPpFT_ACCESS 2 /* use filetest 'access' */
#define OP_IS_FILETEST_ACCESS(op) \
(((op)->op_type) == OP_FTRREAD || \
((op)->op_type) == OP_FTRWRITE || \
((op)->op_type) == OP_FTREXEC || \
((op)->op_type) == OP_FTEREAD || \
((op)->op_type) == OP_FTEWRITE || \
((op)->op_type) == OP_FTEEXEC)
struct op {
BASEOP
};
struct unop {
BASEOP
OP * op_first;
};
struct binop {
BASEOP
OP * op_first;
OP * op_last;
};
struct logop {
BASEOP
OP * op_first;
OP * op_other;
};
struct listop {
BASEOP
OP * op_first;
OP * op_last;
};
struct pmop {
BASEOP
OP * op_first;
OP * op_last;
OP * op_pmreplroot; /* (type is really union {OP*,GV*,PADOFFSET}) */
OP * op_pmreplstart;
PMOP * op_pmnext; /* list of all scanpats */
#ifdef USE_ITHREADS
IV op_pmoffset;
#else
REGEXP * op_pmregexp; /* compiled expression */
#endif
U32 op_pmflags;
U32 op_pmpermflags;
U8 op_pmdynflags;
#ifdef USE_ITHREADS
char * op_pmstashpv;
#else
HV * op_pmstash;
#endif
};
#ifdef USE_ITHREADS
#define PM_GETRE(o) (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset])))
#define PM_SETRE(o,r) STMT_START { SV* sv = PL_regex_pad[(o)->op_pmoffset]; sv_setiv(sv, PTR2IV(r)); } STMT_END
#define PM_GETRE_SAFE(o) (PL_regex_pad ? PM_GETRE(o) : (REGEXP*)0)
#define PM_SETRE_SAFE(o,r) if (PL_regex_pad) PM_SETRE(o,r)
#else
#define PM_GETRE(o) ((o)->op_pmregexp)
#define PM_SETRE(o,r) ((o)->op_pmregexp = (r))
#define PM_GETRE_SAFE PM_GETRE
#define PM_SETRE_SAFE PM_SETRE
#endif
#define PMdf_USED 0x01 /* pm has been used once already */
#define PMdf_TAINTED 0x02 /* pm compiled from tainted pattern */
#define PMdf_UTF8 0x04 /* pm compiled from utf8 data */
#define PMdf_DYN_UTF8 0x08
#define PMdf_CMP_UTF8 (PMdf_UTF8|PMdf_DYN_UTF8)
#define PMf_RETAINT 0x0001 /* taint $1 etc. if target tainted */
#define PMf_ONCE 0x0002 /* use pattern only once per reset */
#define PMf_UNUSED 0x0004 /* free for use */
#define PMf_MAYBE_CONST 0x0008 /* replacement contains variables */
#define PMf_SKIPWHITE 0x0010 /* skip leading whitespace for split */
#define PMf_WHITE 0x0020 /* pattern is \s+ */
#define PMf_CONST 0x0040 /* subst replacement is constant */
#define PMf_KEEP 0x0080 /* keep 1st runtime pattern forever */
#define PMf_GLOBAL 0x0100 /* pattern had a g modifier */
#define PMf_CONTINUE 0x0200 /* don't reset pos() if //g fails */
#define PMf_EVAL 0x0400 /* evaluating replacement as expr */
#define PMf_LOCALE 0x0800 /* use locale for character types */
#define PMf_MULTILINE 0x1000 /* assume multiple lines */
#define PMf_SINGLELINE 0x2000 /* assume single line */
#define PMf_FOLD 0x4000 /* case insensitivity */
#define PMf_EXTENDED 0x8000 /* chuck embedded whitespace */
/* mask of bits stored in regexp->reganch */
#define PMf_COMPILETIME (PMf_MULTILINE|PMf_SINGLELINE|PMf_LOCALE|PMf_FOLD|PMf_EXTENDED)
#ifdef USE_ITHREADS
# define PmopSTASHPV(o) ((o)->op_pmstashpv)
# define PmopSTASHPV_set(o,pv) (PmopSTASHPV(o) = savesharedpv(pv))
# define PmopSTASH(o) (PmopSTASHPV(o) \
? gv_stashpv(PmopSTASHPV(o),GV_ADD) : Nullhv)
# define PmopSTASH_set(o,hv) PmopSTASHPV_set(o, ((hv) ? HvNAME_get(hv) : Nullch))
# define PmopSTASH_free(o) PerlMemShared_free(PmopSTASHPV(o))
#else
# define PmopSTASH(o) ((o)->op_pmstash)
# define PmopSTASH_set(o,hv) ((o)->op_pmstash = (hv))
# define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : Nullch)
/* op_pmstash is not refcounted */
# define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD))
# define PmopSTASH_free(o)
#endif
struct svop {
BASEOP
SV * op_sv;
};
struct padop {
BASEOP
PADOFFSET op_padix;
};
struct pvop {
BASEOP
char * op_pv;
};
struct loop {
BASEOP
OP * op_first;
OP * op_last;
OP * op_redoop;
OP * op_nextop;
OP * op_lastop;
};
#define cUNOPx(o) ((UNOP*)o)
#define cBINOPx(o) ((BINOP*)o)
#define cLISTOPx(o) ((LISTOP*)o)
#define cLOGOPx(o) ((LOGOP*)o)
#define cPMOPx(o) ((PMOP*)o)
#define cSVOPx(o) ((SVOP*)o)
#define cPADOPx(o) ((PADOP*)o)
#define cPVOPx(o) ((PVOP*)o)
#define cCOPx(o) ((COP*)o)
#define cLOOPx(o) ((LOOP*)o)
#define cUNOP cUNOPx(PL_op)
#define cBINOP cBINOPx(PL_op)
#define cLISTOP cLISTOPx(PL_op)
#define cLOGOP cLOGOPx(PL_op)
#define cPMOP cPMOPx(PL_op)
#define cSVOP cSVOPx(PL_op)
#define cPADOP cPADOPx(PL_op)
#define cPVOP cPVOPx(PL_op)
#define cCOP cCOPx(PL_op)
#define cLOOP cLOOPx(PL_op)
#define cUNOPo cUNOPx(o)
#define cBINOPo cBINOPx(o)
#define cLISTOPo cLISTOPx(o)
#define cLOGOPo cLOGOPx(o)
#define cPMOPo cPMOPx(o)
#define cSVOPo cSVOPx(o)
#define cPADOPo cPADOPx(o)
#define cPVOPo cPVOPx(o)
#define cCOPo cCOPx(o)
#define cLOOPo cLOOPx(o)
#define kUNOP cUNOPx(kid)
#define kBINOP cBINOPx(kid)
#define kLISTOP cLISTOPx(kid)
#define kLOGOP cLOGOPx(kid)
#define kPMOP cPMOPx(kid)
#define kSVOP cSVOPx(kid)
#define kPADOP cPADOPx(kid)
#define kPVOP cPVOPx(kid)
#define kCOP cCOPx(kid)
#define kLOOP cLOOPx(kid)
#ifdef USE_ITHREADS
# define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix))
# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v))
# define IS_PADCONST(v) (v && SvREADONLY(v))
# define cSVOPx_sv(v) (cSVOPx(v)->op_sv \
? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ))
# define cSVOPx_svp(v) (cSVOPx(v)->op_sv \
? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ))
#else
# define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv)
# define IS_PADGV(v) FALSE
# define IS_PADCONST(v) FALSE
# define cSVOPx_sv(v) (cSVOPx(v)->op_sv)
# define cSVOPx_svp(v) (&cSVOPx(v)->op_sv)
#endif
#define cGVOP_gv cGVOPx_gv(PL_op)
#define cGVOPo_gv cGVOPx_gv(o)
#define kGVOP_gv cGVOPx_gv(kid)
#define cSVOP_sv cSVOPx_sv(PL_op)
#define cSVOPo_sv cSVOPx_sv(o)
#define kSVOP_sv cSVOPx_sv(kid)
#define Nullop Null(OP*)
/* Lowest byte-and-a-bit of PL_opargs */
#define OA_MARK 1
#define OA_FOLDCONST 2
#define OA_RETSCALAR 4
#define OA_TARGET 8
#define OA_RETINTEGER 16
#define OA_OTHERINT 32
#define OA_DANGEROUS 64
#define OA_DEFGV 128
#define OA_TARGLEX 256
/* The next 4 bits encode op class information */
#define OCSHIFT 9
#define OA_CLASS_MASK (15 << OCSHIFT)
#define OA_BASEOP (0 << OCSHIFT)
#define OA_UNOP (1 << OCSHIFT)
#define OA_BINOP (2 << OCSHIFT)
#define OA_LOGOP (3 << OCSHIFT)
#define OA_LISTOP (4 << OCSHIFT)
#define OA_PMOP (5 << OCSHIFT)
#define OA_SVOP (6 << OCSHIFT)
#define OA_PADOP (7 << OCSHIFT)
#define OA_PVOP_OR_SVOP (8 << OCSHIFT)
#define OA_LOOP (9 << OCSHIFT)
#define OA_COP (10 << OCSHIFT)
#define OA_BASEOP_OR_UNOP (11 << OCSHIFT)
#define OA_FILESTATOP (12 << OCSHIFT)
#define OA_LOOPEXOP (13 << OCSHIFT)
#define OASHIFT 13
/* Remaining nybbles of PL_opargs */
#define OA_SCALAR 1
#define OA_LIST 2
#define OA_AVREF 3
#define OA_HVREF 4
#define OA_CVREF 5
#define OA_FILEREF 6
#define OA_SCALARREF 7
#define OA_OPTIONAL 8
#ifdef USE_ITHREADS
# define OP_REFCNT_INIT MUTEX_INIT(&PL_op_mutex)
# ifdef PERL_CORE
# define OP_REFCNT_LOCK MUTEX_LOCK(&PL_op_mutex)
# define OP_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_op_mutex)
# else
# define OP_REFCNT_LOCK op_refcnt_lock()
# define OP_REFCNT_UNLOCK op_refcnt_unlock()
# endif
# define OP_REFCNT_TERM MUTEX_DESTROY(&PL_op_mutex)
#else
# define OP_REFCNT_INIT NOOP
# define OP_REFCNT_LOCK NOOP
# define OP_REFCNT_UNLOCK NOOP
# define OP_REFCNT_TERM NOOP
#endif
#define OpREFCNT_set(o,n) ((o)->op_targ = (n))
#define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop)
#define OpREFCNT_dec(o) (--(o)->op_targ)
/* flags used by Perl_load_module() */
#define PERL_LOADMOD_DENY 0x1
#define PERL_LOADMOD_NOIMPORT 0x2
#define PERL_LOADMOD_IMPORT_OPS 0x4
#ifdef USE_REENTRANT_API
#include "reentr.h"
#endif
#if defined(PL_OP_SLAB_ALLOC)
#define NewOp(m,var,c,type) \
(var = (type *) Perl_Slab_Alloc(aTHX_ m,c*sizeof(type)))
#define NewOpSz(m,var,size) \
(var = (OP *) Perl_Slab_Alloc(aTHX_ m,size))
#define FreeOp(p) Perl_Slab_Free(aTHX_ p)
#else
#define NewOp(m, var, c, type) Newxz(var, c, type)
#define NewOpSz(m, var, size) \
(var = (OP*)safemalloc(size), memzero(var, size))
#define FreeOp(p) Safefree(p)
#endif
--- NEW FILE: intrpvar.h ---
/***********************************************/
/* Global only to current interpreter instance */
/***********************************************/
/* Don't forget to re-run embed.pl to propagate changes! */
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
/* Don't forget to add your variable also to perl_clone()! */
/* The 'I' prefix is only needed for vars that need appropriate #defines
* generated when built with or without MULTIPLICITY. It is also used
* to generate the appropriate export list for win32.
*
* When building without MULTIPLICITY, these variables will be truly global. */
/* pseudo environmental stuff */
PERLVAR(Iorigargc, int)
PERLVAR(Iorigargv, char **)
PERLVAR(Ienvgv, GV *)
PERLVAR(Iincgv, GV *)
PERLVAR(Ihintgv, GV *)
PERLVAR(Iorigfilename, char *)
PERLVAR(Idiehook, SV *)
PERLVAR(Iwarnhook, SV *)
/* switches */
PERLVAR(Iminus_c, bool)
PERLVAR(Ipatchlevel, SV *)
PERLVAR(Ilocalpatches, char **)
PERLVARI(Isplitstr, const char *, " ")
PERLVAR(Ipreprocess, bool)
PERLVAR(Iminus_n, bool)
PERLVAR(Iminus_p, bool)
PERLVAR(Iminus_l, bool)
PERLVAR(Iminus_a, bool)
PERLVAR(Iminus_F, bool)
PERLVAR(Idoswitches, bool)
/*
=head1 Global Variables
=for apidoc mn|bool|PL_dowarn
The C variable which corresponds to Perl's $^W warning variable.
=cut
*/
PERLVAR(Idowarn, U8)
PERLVAR(Iwidesyscalls, bool) /* unused since 5.8.1 */
PERLVAR(Idoextract, bool)
PERLVAR(Isawampersand, bool) /* must save all match strings */
PERLVAR(Iunsafe, bool)
PERLVAR(Iinplace, char *)
PERLVAR(Ie_script, SV *)
PERLVAR(Iperldb, U32)
/* This value may be set when embedding for full cleanup */
/* 0=none, 1=full, 2=full with checks */
PERLVARI(Iperl_destruct_level, int, 0)
/* magical thingies */
PERLVAR(Ibasetime, Time_t) /* $^T */
PERLVAR(Iformfeed, SV *) /* $^L */
PERLVARI(Imaxsysfd, I32, MAXSYSFD)
/* top fd to pass to subprocesses */
PERLVAR(Imultiline, int) /* $*--do strings hold >1 line? */
PERLVAR(Istatusvalue, I32) /* $? */
PERLVAR(Iexit_flags, U8) /* was exit() unexpected, etc. */
#ifdef VMS
PERLVAR(Istatusvalue_vms,U32)
#endif
/* shortcuts to various I/O objects */
PERLVAR(Istdingv, GV *)
PERLVAR(Istderrgv, GV *)
PERLVAR(Idefgv, GV *)
PERLVAR(Iargvgv, GV *)
PERLVAR(Iargvoutgv, GV *)
PERLVAR(Iargvout_stack, AV *)
/* shortcuts to regexp stuff */
/* this one needs to be moved to thrdvar.h and accessed via
* find_threadsv() when USE_5005THREADS */
PERLVAR(Ireplgv, GV *)
/* shortcuts to misc objects */
PERLVAR(Ierrgv, GV *)
/* shortcuts to debugging objects */
PERLVAR(IDBgv, GV *)
PERLVAR(IDBline, GV *)
/*
=for apidoc mn|GV *|PL_DBsub
When Perl is run in debugging mode, with the B<-d> switch, this GV contains
the SV which holds the name of the sub being debugged. This is the C
variable which corresponds to Perl's $DB::sub variable. See
C<PL_DBsingle>.
=for apidoc mn|SV *|PL_DBsingle
When Perl is run in debugging mode, with the B<-d> switch, this SV is a
boolean which indicates whether subs are being single-stepped.
Single-stepping is automatically turned on after every step. This is the C
variable which corresponds to Perl's $DB::single variable. See
C<PL_DBsub>.
=for apidoc mn|SV *|PL_DBtrace
Trace variable used when Perl is run in debugging mode, with the B<-d>
switch. This is the C variable which corresponds to Perl's $DB::trace
variable. See C<PL_DBsingle>.
=cut
*/
PERLVAR(IDBsub, GV *)
PERLVAR(IDBsingle, SV *)
PERLVAR(IDBtrace, SV *)
PERLVAR(IDBsignal, SV *)
PERLVAR(Ilineary, AV *) /* lines of script for debugger */
PERLVAR(Idbargs, AV *) /* args to call listed by caller function */
/* symbol tables */
PERLVAR(Idebstash, HV *) /* symbol table for perldb package */
PERLVAR(Iglobalstash, HV *) /* global keyword overrides imported here */
PERLVAR(Icurstname, SV *) /* name of current package */
PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */
PERLVAR(Iendav, AV *) /* names of END subroutines */
PERLVAR(Icheckav, AV *) /* names of CHECK subroutines */
PERLVAR(Iinitav, AV *) /* names of INIT subroutines */
PERLVAR(Istrtab, HV *) /* shared string table */
PERLVARI(Isub_generation,U32,1) /* incr to invalidate method cache */
/* memory management */
PERLVAR(Isv_count, I32) /* how many SV* are currently allocated */
PERLVAR(Isv_objcount, I32) /* how many objects are currently allocated */
PERLVAR(Isv_root, SV*) /* storage for SVs belonging to interp */
PERLVAR(Isv_arenaroot, SV*) /* list of areas for garbage collection */
/* funky return mechanisms */
PERLVAR(Iforkprocess, int) /* so do_open |- can return proc# */
/* subprocess state */
PERLVAR(Ifdpid, AV *) /* keep fd-to-pid mappings for my_popen */
/* internal state */
PERLVAR(Itainting, bool) /* doing taint checks */
PERLVARI(Iop_mask, char *, NULL) /* masked operations for safe evals */
/* current interpreter roots */
PERLVAR(Imain_cv, CV *)
PERLVAR(Imain_root, OP *)
PERLVAR(Imain_start, OP *)
PERLVAR(Ieval_root, OP *)
PERLVAR(Ieval_start, OP *)
/* runtime control stuff */
PERLVARI(Icurcopdb, COP *, NULL)
PERLVARI(Icopline, line_t, NOLINE)
/* statics moved here for shared library purposes */
PERLVAR(Ifilemode, int) /* so nextargv() can preserve mode */
PERLVAR(Ilastfd, int) /* what to preserve mode on */
PERLVAR(Ioldname, char *) /* what to preserve mode on */
PERLVAR(IArgv, char **) /* stuff to free from do_aexec, vfork safe */
PERLVAR(ICmd, char *) /* stuff to free from do_aexec, vfork safe */
PERLVARI(Igensym, I32, 0) /* next symbol for getsym() to define */
PERLVAR(Ipreambled, bool)
PERLVAR(Ipreambleav, AV *)
PERLVARI(Ilaststatval, int, -1)
PERLVARI(Ilaststype, I32, OP_STAT)
PERLVAR(Imess_sv, SV *)
/* XXX shouldn't these be per-thread? --GSAR */
PERLVAR(Iors_sv, SV *) /* output record separator $\ */
PERLVAR(Iofmt, char *) /* output format for numbers $# */
/* interpreter atexit processing */
PERLVARI(Iexitlist, PerlExitListEntry *, NULL)
/* list of exit functions */
PERLVARI(Iexitlistlen, I32, 0) /* length of same */
/*
=for apidoc Amn|HV*|PL_modglobal
C<PL_modglobal> is a general purpose, interpreter global HV for use by
extensions that need to keep information on a per-interpreter basis.
In a pinch, it can also be used as a symbol table for extensions
to share data among each other. It is a good idea to use keys
prefixed by the package name of the extension that owns the data.
=cut
*/
PERLVAR(Imodglobal, HV *) /* per-interp module data */
/* these used to be in global before 5.004_68 */
PERLVARI(Iprofiledata, U32 *, NULL) /* table of ops, counts */
PERLVARI(Irsfp, PerlIO * VOL, Nullfp) /* current source file pointer */
PERLVARI(Irsfp_filters, AV *, Nullav) /* keeps active source filters */
PERLVAR(Icompiling, COP) /* compiling/done executing marker */
PERLVAR(Icompcv, CV *) /* currently compiling subroutine */
PERLVAR(IBINCOMPAT0, AV *) /* filler for binary compatibility */
PERLVAR(Icomppad_name, AV *) /* variable names for "my" variables */
PERLVAR(Icomppad_name_fill, I32) /* last "introduced" variable offset */
PERLVAR(Icomppad_name_floor, I32) /* start of vars in innermost block */
#ifdef HAVE_INTERP_INTERN
PERLVAR(Isys_intern, struct interp_intern)
/* platform internals */
#endif
/* more statics moved here */
PERLVARI(Igeneration, int, 100) /* from op.c */
PERLVAR(IDBcv, CV *) /* from perl.c */
PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */
PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */
PERLVAR(Ilinestart, char *) /* beg. of most recently read line */
PERLVAR(Ipending_ident, char) /* pending identifier lookup */
PERLVAR(Isublex_info, SUBLEXINFO) /* from toke.c */
#ifdef USE_5005THREADS
PERLVAR(Ithrsv, SV *) /* struct perl_thread for main thread */
PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */
PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */
#endif /* USE_5005THREADS */
PERLVAR(Iuid, Uid_t) /* current real user id */
PERLVAR(Ieuid, Uid_t) /* current effective user id */
PERLVAR(Igid, Gid_t) /* current real group id */
PERLVAR(Iegid, Gid_t) /* current effective group id */
PERLVAR(Inomemok, bool) /* let malloc context handle nomem */
PERLVARI(Ian, U32, 0) /* malloc sequence number */
PERLVARI(Icop_seqmax, U32, 0) /* statement sequence number */
PERLVARI(Iop_seqmax, U16, 0) /* op sequence number */
PERLVARI(Ievalseq, U32, 0) /* eval sequence number */
PERLVAR(Iorigenviron, char **)
PERLVAR(Iorigalen, U32)
PERLVAR(Ipidstatus, HV *) /* pid-to-status mappings for waitpid */
PERLVARI(Imaxo, int, MAXO) /* maximum number of ops */
PERLVAR(Iosname, char *) /* operating system */
/* For binary compatibility with older versions only */
PERLVARI(Ish_path_compat, const char *, SH_PATH)/* full path of shell */
PERLVAR(Isighandlerp, Sighandler_t)
PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */
PERLVAR(Ixiv_root, IV *) /* free xiv list */
PERLVAR(Ixnv_root, NV *) /* free xnv list */
PERLVAR(Ixrv_root, XRV *) /* free xrv list */
PERLVAR(Ixpv_root, XPV *) /* free xpv list */
PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list */
PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list */
PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list */
PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list */
PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list */
PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list */
PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list */
PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list */
PERLVAR(Ihe_root, HE *) /* free he list */
PERLVAR(Inice_chunk, char *) /* a nice chunk of memory to reuse */
PERLVAR(Inice_chunk_size, U32) /* how nice the chunk of memory is */
PERLVARI(Irunops, runops_proc_t, MEMBER_TO_FPTR(RUNOPS_DEFAULT))
PERLVARA(Itokenbuf,256, char)
/*
=for apidoc Amn|SV|PL_sv_undef
This is the C<undef> SV. Always refer to this as C<&PL_sv_undef>.
=for apidoc Amn|SV|PL_sv_no
This is the C<false> SV. See C<PL_sv_yes>. Always refer to this as
C<&PL_sv_no>.
=for apidoc Amn|SV|PL_sv_yes
This is the C<true> SV. See C<PL_sv_no>. Always refer to this as
C<&PL_sv_yes>.
=cut
*/
PERLVAR(Isv_undef, SV)
PERLVAR(Isv_no, SV)
PERLVAR(Isv_yes, SV)
#ifdef CSH
PERLVARI(Icshname, const char *, CSH)
PERLVARI(Icshlen, I32, 0)
#endif
PERLVAR(Ilex_state, U32) /* next token is determined */
PERLVAR(Ilex_defer, U32) /* state after determined token */
PERLVAR(Ilex_expect, int) /* expect after determined token */
PERLVAR(Ilex_brackets, I32) /* bracket count */
PERLVAR(Ilex_formbrack, I32) /* bracket count at outer format level */
PERLVAR(Ilex_casemods, I32) /* casemod count */
PERLVAR(Ilex_dojoin, I32) /* doing an array interpolation */
PERLVAR(Ilex_starts, I32) /* how many interps done on level */
PERLVAR(Ilex_stuff, SV *) /* runtime pattern from m// or s/// */
PERLVAR(Ilex_repl, SV *) /* runtime replacement from s/// */
PERLVAR(Ilex_op, OP *) /* extra info to pass back on op */
PERLVAR(Ilex_inpat, OP *) /* in pattern $) and $| are special */
PERLVAR(Ilex_inwhat, I32) /* what kind of quoting are we in */
PERLVAR(Ilex_brackstack,char *) /* what kind of brackets to pop */
PERLVAR(Ilex_casestack, char *) /* what kind of case mods in effect */
/* What we know when we're in LEX_KNOWNEXT state. */
PERLVARA(Inextval,5, YYSTYPE) /* value of next token, if any */
PERLVARA(Inexttype,5, I32) /* type of next token */
PERLVAR(Inexttoke, I32)
PERLVAR(Ilinestr, SV *)
PERLVAR(Ibufptr, char *)
PERLVAR(Ioldbufptr, char *)
PERLVAR(Ioldoldbufptr, char *)
PERLVAR(Ibufend, char *)
PERLVARI(Iexpect,int, XSTATE) /* how to interpret ambiguous tokens */
PERLVAR(Imulti_start, I32) /* 1st line of multi-line string */
PERLVAR(Imulti_end, I32) /* last line of multi-line string */
PERLVAR(Imulti_open, I32) /* delimiter of said string */
PERLVAR(Imulti_close, I32) /* delimiter of said string */
PERLVAR(Ierror_count, I32) /* how many errors so far, max 10 */
PERLVAR(Isubline, I32) /* line this subroutine began on */
PERLVAR(Isubname, SV *) /* name of current subroutine */
PERLVAR(Imin_intro_pending, I32) /* start of vars to introduce */
PERLVAR(Imax_intro_pending, I32) /* end of vars to introduce */
PERLVAR(Ipadix, I32) /* max used index in current "register" pad */
PERLVAR(Ipadix_floor, I32) /* how low may inner block reset padix */
PERLVAR(Ipad_reset_pending, I32) /* reset pad on next attempted alloc */
PERLVAR(Ilast_uni, char *) /* position of last named-unary op */
PERLVAR(Ilast_lop, char *) /* position of last list operator */
PERLVAR(Ilast_lop_op, OPCODE) /* last list operator */
PERLVAR(Iin_my, I32) /* we're compiling a "my" (or "our") declaration */
PERLVAR(Iin_my_stash, HV *) /* declared class of this "my" declaration */
#ifdef FCRYPT
PERLVARI(Icryptseen, bool, FALSE) /* has fast crypt() been initialized? */
#endif
PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */
PERLVAR(Idebug, VOL U32) /* flags given to -D switch */
PERLVARI(Iamagic_generation, long, 0)
#ifdef USE_LOCALE_COLLATE
PERLVARI(Icollation_ix, U32, 0) /* Collation generation index */
PERLVAR(Icollation_name,char *) /* Name of current collation */
PERLVARI(Icollation_standard, bool, TRUE)
/* Assume simple collation */
PERLVAR(Icollxfrm_base, Size_t) /* Basic overhead in *xfrm() */
PERLVARI(Icollxfrm_mult,Size_t, 2) /* Expansion factor in *xfrm() */
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
PERLVAR(Inumeric_name, char *) /* Name of current numeric locale */
PERLVARI(Inumeric_standard, bool, TRUE)
/* Assume simple numerics */
PERLVARI(Inumeric_local, bool, TRUE)
/* Assume local numerics */
PERLVAR(Inumeric_compat1, char)
/* Used to be numeric_radix */
#endif /* !USE_LOCALE_NUMERIC */
/* utf8 character classes */
PERLVAR(Iutf8_alnum, SV *)
PERLVAR(Iutf8_alnumc, SV *)
PERLVAR(Iutf8_ascii, SV *)
PERLVAR(Iutf8_alpha, SV *)
PERLVAR(Iutf8_space, SV *)
PERLVAR(Iutf8_cntrl, SV *)
PERLVAR(Iutf8_graph, SV *)
PERLVAR(Iutf8_digit, SV *)
PERLVAR(Iutf8_upper, SV *)
PERLVAR(Iutf8_lower, SV *)
PERLVAR(Iutf8_print, SV *)
PERLVAR(Iutf8_punct, SV *)
PERLVAR(Iutf8_xdigit, SV *)
PERLVAR(Iutf8_mark, SV *)
PERLVAR(Iutf8_toupper, SV *)
PERLVAR(Iutf8_totitle, SV *)
PERLVAR(Iutf8_tolower, SV *)
PERLVAR(Iutf8_tofold, SV *)
PERLVAR(Ilast_swash_hv, HV *)
PERLVAR(Ilast_swash_klen, U32)
PERLVARA(Ilast_swash_key,10, U8)
PERLVAR(Ilast_swash_tmps, U8 *)
PERLVAR(Ilast_swash_slen, STRLEN)
/* perly.c globals */
PERLVAR(Iyydebug, int)
PERLVAR(Iyynerrs, int)
PERLVAR(Iyyerrflag, int)
PERLVAR(Iyychar, int)
PERLVAR(Iyyval, YYSTYPE)
PERLVAR(Iyylval, YYSTYPE)
PERLVARI(Iglob_index, int, 0)
PERLVAR(Isrand_called, bool)
PERLVARA(Iuudmap,256, char)
PERLVAR(Ibitcount, char *)
#ifdef USE_5005THREADS
PERLVAR(Isv_mutex, perl_mutex) /* Mutex for allocating SVs in sv.c */
PERLVAR(Ieval_mutex, perl_mutex) /* Mutex for doeval */
PERLVAR(Ieval_cond, perl_cond) /* Condition variable for doeval */
PERLVAR(Ieval_owner, struct perl_thread *)
/* Owner thread for doeval */
PERLVAR(Inthreads, int) /* Number of threads currently */
PERLVAR(Ithreads_mutex, perl_mutex) /* Mutex for nthreads and thread list */
PERLVAR(Inthreads_cond, perl_cond) /* Condition variable for nthreads */
PERLVAR(Isvref_mutex, perl_mutex) /* Mutex for SvREFCNT_{inc,dec} */
PERLVARI(Ithreadsv_names,char *, THREADSV_NAMES)
#ifdef FAKE_THREADS
PERLVAR(Icurthr, struct perl_thread *)
/* Currently executing (fake) thread */
#endif
PERLVAR(Icred_mutex, perl_mutex) /* altered credentials in effect */
#endif /* USE_5005THREADS */
PERLVAR(Ipsig_ptr, SV**)
PERLVAR(Ipsig_name, SV**)
#if defined(PERL_IMPLICIT_SYS)
PERLVAR(IMem, struct IPerlMem*)
PERLVAR(IMemShared, struct IPerlMem*)
PERLVAR(IMemParse, struct IPerlMem*)
PERLVAR(IEnv, struct IPerlEnv*)
PERLVAR(IStdIO, struct IPerlStdIO*)
PERLVAR(ILIO, struct IPerlLIO*)
PERLVAR(IDir, struct IPerlDir*)
PERLVAR(ISock, struct IPerlSock*)
PERLVAR(IProc, struct IPerlProc*)
#endif
#if defined(USE_ITHREADS)
PERLVAR(Iptr_table, PTR_TBL_t*)
#endif
PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */
#ifdef USE_5005THREADS
PERLVAR(Ifdpid_mutex, perl_mutex) /* mutex for fdpid array */
PERLVAR(Isv_lock_mutex, perl_mutex) /* mutex for SvLOCK macro */
#endif
PERLVAR(Inullstash, HV *) /* illegal symbols end up here */
PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas */
PERLVAR(Ixrv_arenaroot, XPV*) /* list of allocated xrv areas */
PERLVAR(Ixpv_arenaroot, XPV*) /* list of allocated xpv areas */
PERLVAR(Ixpviv_arenaroot,XPVIV*) /* list of allocated xpviv areas */
PERLVAR(Ixpvnv_arenaroot,XPVNV*) /* list of allocated xpvnv areas */
PERLVAR(Ixpvcv_arenaroot,XPVCV*) /* list of allocated xpvcv areas */
PERLVAR(Ixpvav_arenaroot,XPVAV*) /* list of allocated xpvav areas */
PERLVAR(Ixpvhv_arenaroot,XPVHV*) /* list of allocated xpvhv areas */
PERLVAR(Ixpvmg_arenaroot,XPVMG*) /* list of allocated xpvmg areas */
PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */
PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */
PERLVAR(Ihe_arenaroot, XPV*) /* list of allocated he areas */
/* 5.6.0 stopped here */
PERLVAR(Ipsig_pend, int *) /* per-signal "count" of pending */
PERLVARI(Isig_pending, int,0) /* Number if highest signal pending */
#ifdef USE_LOCALE_NUMERIC
PERLVAR(Inumeric_radix_sv, SV *) /* The radix separator if not '.' */
#endif
#if defined(USE_ITHREADS)
PERLVAR(Iregex_pad, SV**) /* All regex objects */
PERLVAR(Iregex_padav, AV*) /* All regex objects */
#endif
#ifdef USE_REENTRANT_API
PERLVAR(Ireentrant_buffer, REENTR*) /* here we store the _r buffers */
#endif
PERLVARI(Isavebegin, bool, FALSE) /* save BEGINs for compiler */
PERLVAR(Icustom_op_names, HV*) /* Names of user defined ops */
PERLVAR(Icustom_op_descs, HV*) /* Descriptions of user defined ops */
#ifdef PERLIO_LAYERS
PERLVARI(Iperlio, PerlIO *,NULL)
PERLVARI(Iknown_layers, PerlIO_list_t *,NULL)
PERLVARI(Idef_layerlist, PerlIO_list_t *,NULL)
#endif
PERLVARI(Iencoding, SV*, Nullsv) /* character encoding */
PERLVAR(Idebug_pad, struct perl_debug_pad) /* always needed because of the re extension */
PERLVAR(Itaint_warn, bool) /* taint warns instead of dying */
#ifdef PL_OP_SLAB_ALLOC
PERLVAR(IOpPtr,I32 **)
PERLVARI(IOpSpace,I32,0)
PERLVAR(IOpSlab,I32 *)
#endif
PERLVAR(Iutf8locale, bool) /* utf8 locale detected */
PERLVAR(Iutf8_idstart, SV *)
PERLVAR(Iutf8_idcont, SV *)
PERLVAR(Isort_RealCmp, SVCOMPARE_t)
PERLVARI(Icheckav_save, AV*, Nullav) /* save CHECK{}s when compiling */
PERLVARI(Iclocktick, long, 0) /* this many times() ticks in a second */
PERLVARI(Iin_load_module, int, 0) /* to prevent recursions in PerlIO_find_layer */
PERLVAR(Iunicode, U32) /* Unicode features: $ENV{PERL_UNICODE} or -C */
PERLVAR(Isignals, U32) /* Using which pre-5.8 signals */
PERLVAR(Istashcache, HV *) /* Cache to speed up S_method_common */
PERLVAR(Ireentrant_retint, int) /* Integer return value from reentrant functions */
/* Hooks to shared SVs and locks. */
PERLVARI(Isharehook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nosharing))
PERLVARI(Ilockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nolocking))
PERLVARI(Iunlockhook, share_proc_t, MEMBER_TO_FPTR(Perl_sv_nounlocking))
PERLVARI(Ithreadhook, thrhook_proc_t, MEMBER_TO_FPTR(Perl_nothreadhook))
/* Force inclusion of both runops options */
PERLVARI(Irunops_std, runops_proc_t, MEMBER_TO_FPTR(Perl_runops_standard))
PERLVARI(Irunops_dbg, runops_proc_t, MEMBER_TO_FPTR(Perl_runops_debug))
/* Stores the PPID */
#ifdef THREADS_HAVE_PIDS
PERLVARI(Ippid, IV, 0)
#endif
PERLVARI(Ihash_seed, UV, 0) /* Hash initializer */
PERLVARI(Ihash_seed_set, bool, FALSE) /* Hash initialized? */
PERLVARI(Irehash_seed, UV, 0) /* 582 hash initializer */
PERLVARI(Irehash_seed_set, bool, FALSE) /* 582 hash initialized? */
/* These two variables are needed to preserve 5.8.x bincompat because we can't
change function prototypes of two exported functions. Probably should be
taken out of blead soon, and relevant prototypes changed. */
PERLVARI(Ifdscript, int, -1) /* fd for script */
PERLVARI(Isuidscript, int, -1) /* fd for suid script */
#if defined(USE_ITHREADS)
PERLVAR(Ipte_root, struct ptr_tbl_ent *) /* free ptr_tbl_ent list */
PERLVAR(Ipte_arenaroot, XPV*) /* list of allocated pte areas */
#endif
/* New variables must be added to the very end, before this comment,
* for binary compatibility (the offsets of the old members must not change).
* (Don't forget to add your variable also to perl_clone()!)
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h.
*/
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
/* File descriptor to talk to the child which dumps scalars. */
PERLVARI(Idumper_fd, int, -1)
#endif
--- NEW FILE: op.c ---
/* op.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "You see: Mr. Drogo, he married poor Miss Primula Brandybuck. She was
* our Mr. Bilbo's first cousin on the mother's side (her mother being the
* youngest of the Old Took's daughters); and Mr. Drogo was his second
* cousin. So Mr. Frodo is his first *and* second cousin, once removed
* either way, as the saying is, if you follow me." --the Gaffer
*/
/* This file contains the functions that create, manipulate and optimize
[...7070 lines suppressed...]
if (items != 0) {
#if 0
Perl_croak(aTHX_ "usage: %s::%s()",
HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
#endif
}
EXTEND(sp, 1);
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.tru64 ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.tru64 - Perl version 5 on Tru64 (formerly known as Digital UNIX formerly known as DEC OSF/1) systems
=head1 DESCRIPTION
This document describes various features of HP's (formerly Compaq's,
formerly Digital's) Unix operating system (Tru64) that will affect
how Perl version 5 (hereafter just Perl) is configured, 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 at the
very least the release of 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 many
of the op/regexp and op/pat, or ext/Storable tests dumping core
(the exact pattern of failures depending on the GCC release and
optimization flags).
gcc 3.2.1 is known to work okay with Perl 5.8.0. However, when
optimizing the toke.c gcc likes to have a lot of memory, 256 megabytes
seems to be enough. The default setting of the process data section
in Tru64 should be one gigabyte, but some sites/setups might have
lowered that. The configuration process of Perl checks for too low
process limits, and lowers the optimization for the toke.c if
necessary, and also gives advice on how to raise the process limits.
=head2 Using Large Files with Perl on Tru64
In Tru64 Perl is automatically able to use large files, that is,
files larger than 2 gigabytes, there is no need to use the Configure
-Duselargefiles option as described in INSTALL (though using the option
is harmless).
=head2 Threaded Perl on Tru64
If you want to use threads, you should primarily use the new Perl
5.8.0 threads model by running Configure with -Duseithreads.
The old Perl 5.005 threads is obsolete, unmaintained, and its use is
discouraged. If you really want it, run Configure with the
-Dusethreads -Duse5005threads options as described in INSTALL.
Either thread model is going to work only in Tru64 4.0 and newer
releases, older operating releases like 3.2 aren't probably going
to work properly with threads.
In Tru64 V5 (at least V5.1A, V5.1B) you cannot build threaded Perl with gcc
because the system header <pthread.h> explicitly checks for supported
C compilers, gcc (at least 3.2.2) not being one of them. But the
system C compiler should work just fine.
=head2 Long Doubles on Tru64
You cannot Configure Perl to use long doubles unless you have at least
Tru64 V5.0, the long double support simply wasn't functional enough
before that. Perl's Configure will override attempts to use the long
doubles (you can notice this by Configure finding out that the modfl()
function does not work as it should).
At the time of this writing (June 2002), there is a known bug in the
Tru64 libc printing of long doubles when not using "e" notation.
The values are correct and usable, but you only get a limited number
of digits displayed unless you force the issue by using C<printf
"%.33e",$num> or the like. For Tru64 versions V5.0A through V5.1A, a
patch is expected sometime after perl 5.8.0 is released. If your libc
has not yet been patched, you'll get a warning from Configure when
selecting long doubles.
=head2 DB_File tests failing on Tru64
The DB_File tests (db-btree.t, db-hash.t, db-recno.t) may fail you
have installed a newer version of Berkeley DB into the system and the
-I and -L compiler and linker flags introduce version conflicts with
the DB 1.85 headers and libraries that came with the Tru64. For example,
mixing a DB v2 library with the DB v1 headers is a bad idea. Watch
out for Configure options -Dlocincpth and -Dloclibpth, and check your
/usr/local/include and /usr/local/lib since they are included by default.
The second option is to explicitly instruct Configure to detect the
newer Berkeley DB installation, by supplying the right directories with
C<-Dlocincpth=/some/include> and C<-Dloclibpth=/some/lib> B<and> before
running "make test" setting your LD_LIBRARY_PATH to F</some/lib>.
The third option is to work around the problem by disabling the
DB_File completely when build Perl by specifying -Ui_db to Configure,
and then using the BerkeleyDB module from CPAN instead of DB_File.
The BerkeleyDB works with Berkeley DB versions 2.* or greater.
The Berkeley DB 4.1.25 has been tested with Tru64 V5.1A and found
to work. The latest Berkeley DB can be found from F<http://www.sleepycat.com>.
=head2 64-bit Perl on Tru64
In Tru64 Perl's integers are automatically 64-bit wide, there is
no need to use the Configure -Duse64bitint option as described
in INSTALL. Similarly, there is no need for -Duse64bitall
since pointers are automatically 64-bit wide.
=head2 Warnings about floating-point overflow when compiling Perl on Tru64
When compiling Perl in Tru64 you may (depending on the compiler
release) see two warnings like this
cc: Warning: numeric.c, line 104: In this statement, floating-point overflow occurs in evaluating the expression "1.8e308". (floatoverfl)
return HUGE_VAL;
-----------^
and when compiling the POSIX extension
cc: Warning: const-c.inc, line 2007: In this statement, floating-point overflow occurs in evaluating the expression "1.8e308". (floatoverfl)
return HUGE_VAL;
-------------------^
The exact line numbers may vary between Perl releases. The warnings
are benign and can be ignored: in later C compiler releases the warnings
should be gone.
When the file F<pp_sys.c> is being compiled you may (depending on the
operating system release) see an additional compiler flag being used:
C<-DNO_EFF_ONLY_OK>. This is normal and refers to a feature that is
relevant only if you use the C<filetest> pragma. In older releases of
the operating system the feature was broken and the NO_EFF_ONLY_OK
instructs Perl not to use the feature.
=head1 Testing Perl on Tru64
During "make test" the C<comp/cpp> will be skipped because on Tru64 it
cannot be tested before Perl has been installed. The test refers to
the use of the C<-P> option of Perl.
=head1 ext/ODBM_File/odbm Test Failing With Static Builds
The ext/ODBM_File/odbm is known to fail with static builds
(Configure -Uusedl) due to a known bug in Tru64's static libdbm
library. The good news is that you very probably don't need to ever
use the ODBM_File extension since more advanced NDBM_File works fine,
not to mention the even more advanced DB_File.
=head1 Perl Fails Because Of Unresolved Symbol sockatmark
If you get an error like
Can't load '.../OSF1/lib/perl5/5.8.0/alpha-dec_osf/auto/IO/IO.so' for module IO: Unresolved symbol in .../lib/perl5/5.8.0/alpha-dec_osf/auto/IO/IO.so: sockatmark at .../lib/perl5/5.8.0/alpha-dec_osf/XSLoader.pm line 75.
you need to either recompile your Perl in Tru64 4.0D or upgrade your
Tru64 4.0D to at least 4.0F: the sockatmark() system call was
added in Tru64 4.0F, and the IO extension refers that symbol.
=head1 AUTHOR
Jarkko Hietaniemi <jhi at iki.fi>
=cut
--- NEW FILE: Todo.micro ---
- make creating uconfig.sh automatic (by pumpkin)
- make creating Makefile.micro automatic (by pumpkin)
- do away with fork/exec/wait? (system, popen should be enough?)
- some of the uconfig.sh really needs to be probed (using cc) in buildtime:
(uConfigure? :-) native datatype widths and endianness come to mind
--- NEW FILE: embed.fnc ---
: Lines are of the form:
: flags|return_type|function_name|arg1|arg2|...|argN
:
: A line may be continued on another by ending it with a backslash.
: Leading and trailing whitespace will be ignored in each component.
:
: flags are single letters with following meanings:
: A member of public API
: m Implemented as a macro - no export, no
: proto, no #define
: d function has documentation with its source
: s static function, should have an S_ prefix in
: source file; for macros (m), suffix the usage
: example with a semicolon
: n has no implicit interpreter/thread context argument
: p function has a Perl_ prefix
: f function takes printf style format string, varargs
: r function never returns
: o has no compatibility macro (#define foo Perl_foo)
[...1546 lines suppressed...]
p |void |offer_nice_chunk |NN void *chunk|U32 chunk_size
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
p |void |dump_sv_child |NN SV *sv
#endif
#ifdef PERL_DONT_CREATE_GVSV
Ap |GV* |gv_SVadd |NN GV* gv
#endif
Apo |bool |ckwarn |U32 w
Apo |bool |ckwarn_d |U32 w
px |void |my_clearenv
END_EXTERN_C
/*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.jp ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
The following documentation is written in euc-jp encoding.
=head1 NAME
perljp - ÆüËܸì Perl ¥¬¥¤¥É
=head1 ÀâÌÀ
Perl ¤ÎÀ¤³¦¤Ø¤è¤¦¤³¤½!
Perl 5.8.0 ¤è¤ê¡¢Unicode¥µ¥Ý¡¼¥È¤¬ÂçÉý¤Ë¶¯²½¤µ¤ì¡¢¤½¤Î·ë²Ì¥é¥Æ¥óʸ»ú°Ê³°¤Îʸ»ú¥³¡¼¥É¤Î¥µ¥Ý¡¼¥È¤¬ CJK (Ãæ¹ñ¸ì¡¢ÆüËܸ졢¥Ï¥ó¥°¥ë)¤ò´Þ¤á¤Æ²Ã¤ï¤ê¤Þ¤·¤¿¡£Unicode¤ÏÀ¤³¦Ãæ¤Îʸ»ú¤ò°ì¤Ä¤Îʸ»ú¥³¡¼¥É¤Ç°·¤¦¤³¤È¤òÌܻؤ·¤¿É¸½àµ¬³Ê¤Ç¤¢¤ê¡¢Å줫¤éÀ¾¡¢¤Ï¤¿¤Þ¤¿¤½¤Î´Ö¤Îʸ»ú¡Ê¥®¥ê¥·¥ãʸ»ú¡¢¥¥ê¡¼¥ëʸ»ú¡¢¥¢¥é¥Ó¥¢Ê¸»ú¡¢¥Ø¥Ö¥é¥¤Ê¸»ú¡¢¥Ç¥£¡¼¥ô¥¡¥Ê¥¬¡¼¥êʸ»ú¡¢¤Ê¤É¤Ê¤É¡Ë¤ä¡¢¤³¤ì¤Þ¤Ç¤ÏOS¥Ù¥ó¥À¡¼¤¬Æȼ«¤ËÄê¤á¤Æ¤¤¤¿Ê¸»ú(PC¤ª¤è¤ÓMacintosh)¤¬¤¹¤Ç¤Ë´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£
Perl ¼«¿È¤Ï Unicode ¤ÇÆ°ºî¤·¤Þ¤¹¡£Perl ¥¹¥¯¥ê¥×¥ÈÆâ¤Îʸ»úÎó¥ê¥Æ¥é¥ë¤äÀµµ¬É½¸½¤Ï Unicode ¤òÁ°Äó¤È¤·¤Æ¤¤¤Þ¤¹¡£¤½¤·¤ÆÆþ½ÐÎϤΤ¿¤á¤Ë¤Ï¡¢¤³¤ì¤Þ¤Ç»È¤ï¤ì¤Æ¤¤¿¤µ¤Þ¤¶¤Þ¤Êʸ»ú¥³¡¼¥É¤ËÂбþ¤¹¤ë¥â¥¸¥å¡¼¥ë¡¢¡Ö Encode ¡×¤¬É¸½àÁõÈ÷¤µ¤ì¤Æ¤ª¤ê¡¢Unicode ¤È¤³¤ì¤é¤Îʸ»ú¥³¡¼¥É¤ÎÁê¸ßÊÑ´¹¤â´Êñ¤Ë¹Ô¤¨¤ë¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤Þ¤¹¡£
¸½»þÅÀ¤Ç Encode ¤¬¥µ¥Ý¡¼¥È¤¹¤ëʸ»ú¥³¡¼¥É¤Ï°Ê²¼¤Î¤È¤ª¤ê¤Ç¤¹¡£
7bit-jis AdobeStandardEncoding AdobeSymbol AdobeZdingbat
ascii big5 big5-hkscs cp1006
cp1026 cp1047 cp1250 cp1251
cp1252 cp1253 cp1254 cp1255
cp1256 cp1257 cp1258 cp37
cp424 cp437 cp500 cp737
cp775 cp850 cp852 cp855
cp856 cp857 cp860 cp861
cp862 cp863 cp864 cp865
cp866 cp869 cp874 cp875
cp932 cp936 cp949 cp950
dingbats euc-cn euc-jp euc-kr
gb12345-raw gb2312-raw gsm0338 hp-roman8
hz iso-2022-jp iso-2022-jp-1 iso-8859-1
iso-8859-10 iso-8859-11 iso-8859-13 iso-8859-14
iso-8859-15 iso-8859-16 iso-8859-2 iso-8859-3
iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7
iso-8859-8 iso-8859-9 iso-ir-165 jis0201-raw
jis0208-raw jis0212-raw johab koi8-f
koi8-r koi8-u ksc5601-raw MacArabic
MacCentralEurRoman MacChineseSimp MacChineseTrad MacCroatian
MacCyrillic MacDingbats MacFarsi MacGreek
MacHebrew MacIcelandic MacJapanese MacKorean
MacRoman MacRomanian MacRumanian MacSami
MacSymbol MacThai MacTurkish MacUkrainian
nextstep posix-bc shiftjis symbol
UCS-2BE UCS-2LE UTF-16 UTF-16BE
UTF-16LE UTF-32 UTF-32BE UTF-32LE
utf8 viscii
(Á´114¼ïÎà)
Î㤨¤Ð¡¢Ê¸»ú¥³¡¼¥ÉFOO¤Î¥Õ¥¡¥¤¥ë¤òUTF-8¤ËÊÑ´¹¤¹¤ë¤Ë¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ë¤·¤Þ¤¹¡£
perl -Mencoding=FOO,STDOUT,utf8 -pe1 < file.FOO > file.utf8
¤Þ¤¿¡¢Perl¤Ë¤Ï¡¢Á´Éô¤¬Perl¤Ç½ñ¤«¤ì¤¿Ê¸»ú¥³¡¼¥ÉÊÑ´¹¥æ¡¼¥Æ¥£¥ê¥Æ¥£¡¢piconv¤âÉÕ°¤·¤Æ¤¤¤ë¤Î¤Ç¡¢°Ê²¼¤Î¤è¤¦¤Ë¤¹¤ë¤³¤È¤â¤Ç¤¤Þ¤¹¡£
piconv -f FOO -t utf8 < file.FOO > file.utf8
piconv -f utf8 -t FOO < file.utf8 > file.FOO
=head2 About (jcode.pl|Jcode.pm|JPerl)
5.8°ÊÁ°¤Î¡¢¥¹¥¯¥ê¥×¥È¤¬EUC-JP¤Ç¤¢¤ì¤Ð¥ê¥Æ¥é¥ë¤À¤±¤Ï°·¤¦¤³¤È¤¬¤Ç¤¤Þ¤·¤¿¡£¤Þ¤¿¡¢Æþ½ÐÎϤò°·¤¦¥â¥¸¥å¡¼¥ë¤È¤·¤Æ¤ÏJcode.pm¤¬( http://openlab.jp/Jcode/ )¡¢perl4ÍѤΥ桼¥Æ¥£¥ê¥Æ¥£¤È¤·¤Æ¤Ïjcode.pl( http://srekcah.org/jcode/ )¤¬¤½¤ì¤¾¤ì¸ºß¤·¡¢ÆüËܸì¤Î°·¤¨¤ëCGI¤Ç¤è¤¯ÍøÍѤµ¤ì¤Æ¤¤¤ë¤³¤È¤ò¸æ¸¤¸¤ÎÊý¤â¾¯¤Ê¤¯¤Ê¤¤¤«¤È»×¤ï¤ì¤Þ¤¹¡£¤¿¤À¤·¡¢ÆüËܸì¤Ë¤è¤ëÀµµ¬É½¸½¤ò¤¦¤Þ¤¯°·¤¦¤³¤È¤ÏÉÔ²Äǽ¤Ç¤·¤¿¡£
5.005°ÊÁ°¤ÎPerl¤Ë¤Ï¡¢ÆüËܸì¤ËÆò½¤·¤¿¥í¡¼¥«¥é¥¤¥ºÈÇ¡¢Jperl¤¬Â¸ºß¤·¤Þ¤·¤¿( http://homepage2.nifty.com/kipp/perl/jperl/index.html )¡£¤Þ¤¿¡¢Mac OS 9.x/ClassicÍѤÎPerl¡¢MacPerl¤ÎÆüËܸìÈǤâMacJPerl¤È¤·¤Æ¸ºß¤·¤Æ¤Þ¤·¤¿¡£( http://world.std.com/~habilis/macjperl/ ).¤³¤ì¤é¤Ç¤Ïʸ»ú¥³¡¼¥É¤È¤·¤ÆEUC-JP¤Ë²Ã¤¨Shift_JIS¤â¤½¤Î¤Þ¤Þ°·¤¦¤³¤È¤¬¤Ç¤¡¢¤Þ¤¿ÆüËܸì¤Ë¤è¤ëÀµµ¬É½¸½¤ò°·¤¦¤³¤È¤â²Äǽ¤Ç¤·¤¿¡£
Perl5.8¤Ç¤Ï¡¢¤³¤ì¤é¤Îµ¡Ç½¤¬¤¹¤Ù¤ÆPerlËÜÂΤÀ¤±¤Ç¼Â¸½¤Ç¤¤ë¾å¤Ë¡¢ÆüËܸì¤Î¤ß¤Ê¤é¤º¾åµ114¤Îʸ»ú¥³¡¼¥É¤ò¤¹¤Ù¤Æ¡¢¤·¤«¤âƱ»þ¤Ë°·¤¦¤³¤È¤¬¤Ç¤¤Þ¤¹¡£¤µ¤é¤Ë¡¢CPAN¤Ê¤É¤«¤é¿·¤·¤¤Ê¸»ú¥³¡¼¥ÉÍѤΥ⥸¥å¡¼¥ë¤òÆþ¼ê¤¹¤ë¤³¤È¤â´Êñ¤Ë¤Ç¤¤ë¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤Þ¤¹¡£
=over 4
=item *
Æþ½ÐÎÏ
°Ê²¼¤ÎÎã¤Ï¤¤¤Å¤ì¤âShift_JIS¤ÎÆþÎϤòEUC-JP¤ËÊÑ´¹¤·¤Æ½ÐÎϤ·¤Þ¤¹¡£
# jcode.pl
require "jcode.pl";
while(<>){
jcode::convert(*_, 'euc', 'sjis');
print;
}
# Jcode.pm
use Jcode;
while(<>){
print Jcode->new($_, 'sjis')->euc;
}
# Perl 5.8
use Encode;
while(<>){
from_to($_, 'shiftjis', 'euc-jp');
print;
}
# Perl 5.8 - encoding ¤òÍøÍѤ·¤Æ
use encoding 'euc-jp', STDIN => 'shiftjis';
while(<>){
print;
}
=item *
Jperl ¸ß´¹¥¹¥¯¥ê¥×¥È
¤¤¤ï¤æ¤ë"shebang"¤òÊѹ¹¤¹¤ë¤À¤±¤Ç¡¢JperlÍѤÎscript¤Î¤Û¤È¤ó¤É¤ÏÊѹ¹¤Ê¤·¤ËÍøÍѲÄǽ¤À¤È»×¤ï¤ì¤Þ¤¹¡£
#!/path/to/jperl
¢
#!/path/to/perl -Mencoding=euc-jp
¾Ü¤·¤¯¤Ï perldoc encoding ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£
=back
=head2 ¤µ¤é¤Ë¾Ü¤·¤¯
Perl¤Ë¤ÏËÄÂç¤Ê»ñÎÁ¤¬ÉÕ°¤·¤Æ¤ª¤ê¡¢Perl¤Î¿·µ¡Ç½¤äUnicode¥µ¥Ý¡¼¥È¡¢¤½¤·¤ÆEncode¥â¥¸¥å¡¼¥ë¤Î»ÈÍÑË¡¤Ê¤É¤¬ºÙ¤«¤¯ÌÖÍ夵¤ì¤Æ¤¤¤Þ¤¹¡Ê»ÄÇ°¤Ê¤¬¤é¡¢¤Û¤È¤ó¤É±Ñ¸ì¤Ç¤Ï¤¢¤ê¤Þ¤¹¤¬¡Ë¡£°Ê²¼¤Î¥³¥Þ¥ó¥É¤Ç¤½¤ì¤é¤Î°ìÉô¤ò±ÜÍ÷¤¹¤ë¤³¤È¤¬²Äǽ¤Ç¤¹¡£
perldoc perlunicode # Perl¤ÎUnicode¥µ¥Ý¡¼¥ÈÁ´ÈÌ
perldoc Encode # Encode¥â¥¸¥å¡¼¥ë¤Ë´Ø¤·¤Æ
perldoc Encode::JP # ¤¦¤ÁÆüËܸìʸ»ú¥³¡¼¥É¤Ë´Ø¤·¤Æ
=head2 PerlÁ´È̤˴ؤ¹¤ë URL
=over 4
=item L<http://www.perl.com/>
Perl ¥Û¡¼¥à¥Ú¡¼¥¸ (O'Reilly and Associates)
=item L<http://www.cpan.org/>
CPAN (Comprehensive Perl Archive Network)
=item L<http://lists.perl.org/>
Perl ¥á¡¼¥ê¥ó¥°¥ê¥¹¥È½¸
=back
=head2 Perl¤Î½¤ÆÀ¤ËÌòΩ¤Ä URL
=over 4
=item L<http://www.oreilly.com.tw/chinese/>
O'Reilly ¼Ò¤ÎPerl´ØÏ¢½ñÀÒ(ÈËÂλúÃæ¹ñ¸ì)
=item L<http://www.oreilly.com.cn/chinese/>
O'Reilly ¼Ò¤ÎPerl´ØÏ¢½ñÀÒ(´ÊÂλúÃæ¹ñ¸ì)
=item L<http://www.oreilly.co.jp/catalog.htm>
¥ª¥é¥¤¥ê¡¼¼Ò¤ÎPerl´ØÏ¢½ñÀÒ(ÆüËܸì)
=back
=head2 Perl ¥æ¡¼¥¶¡¼¥°¥ë¡¼¥×
=over 4
=item L<http://www.pm.org/groups/asia.shtml#China>
Ãæ¹ñ¡ÊÃæ²Ú¿Í̱¶¦Ï¹ñ¡Ë
=item L<http://www.pm.org/groups/asia.shtml#Japan>
ÆüËÜ
=item L<http://www.pm.org/groups/asia.shtml#Korea%20(Republic%20of)>
´Ú¹ñ¡ÊÂç´Ú̱¹ñ¡Ë
=item L<http://www.pm.org/groups/asia.shtml#Taiwan>
ÂæÏÑ¡ÊÃæ²Ú̱¹ñ¡Ë
=back
=head2 Unicode´ØÏ¢¤ÎURL
=over 4
=item L<http://www.unicode.org/>
Unicode ¥³¥ó¥½¡¼¥·¥¢¥à (Unicodeµ¬³Ê¤ÎÁªÄêÃÄÂÎ)
=item L<http://www.cl.cam.ac.uk/%7Emgk25/unicode.html>
UTF-8 and Unicode FAQ for Unix/Linux
=item L<http://kldp.org/Translations/html/UTF8-Unicode-KLDP/UTF8-Unicode-KLDP.html>
UTF-8 and Unicode FAQ for Unix/Linux (¥Ï¥ó¥°¥ëÌõ)
=back
=head1 AUTHORS
Jarkko Hietaniemi E<lt>jhi at iki.fiE<gt>
Dan Kogai (¾®»ô¡¡ÃÆ) E<lt>dankogai at dan.co.jpE<gt>
=cut
--- NEW FILE: README.micro ---
microperl is supposed to be a really minimal perl, even more
minimal than miniperl. No Configure is needed to build microperl,
on the other hand this means that interfaces between Perl and your
operating system are left very -- minimal.
All this is experimental. If you don't know what to do with microperl
you probably shouldn't. Do not report bugs in microperl; fix the bugs.
We assume ANSI C89 plus the following:
- <stdlib.h>
- rename()
- opendir(), readdir(), closedir() (via dirent.h)
- memchr (via string.h)
- (a safe) putenv() (via stdlib.h)
- strtoul() (via stdlib.h)
(grep for 'define' in uconfig.sh.)
Also, Perl times() is defined to always return zeroes.
If you are still reading this and you are itching to try out microperl:
make -f Makefile.micro
If you make changes to uconfig.sh, run
make -f Makefile.micro regen_uconfig
to regenerate uconfig.h.
--- NEW FILE: minimod.pl ---
# minimod.PL writes the contents of miniperlmain.c into the module
# ExtUtils::Miniperl for later perusal (when the perl source is
# deleted)
#
# It also writes the subroutine writemain(), which takes as its
# arguments module names that shall be statically linked into perl.
#
# Authors: Andreas Koenig <k at franz.ww.TU-Berlin.DE>, Tim Bunce
# <Tim.Bunce at ig.co.uk>
#
# Version 1.0, Feb 2nd 1995 by Andreas Koenig
print <<'END';
# This File keeps the contents of miniperlmain.c.
#
# It was generated automatically by minimod.PL from the contents
# of miniperlmain.c. Don't edit this file!
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
package ExtUtils::Miniperl;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&writemain);
$head= <<'EOF!HEAD';
END
open MINI, "miniperlmain.c";
while (<MINI>) {
last if /Do not delete this line--writemain depends on it/;
print;
}
print <<'END';
EOF!HEAD
$tail=<<'EOF!TAIL';
END
while (<MINI>) {
print unless /dXSUB_SYS/;
}
close MINI;
print <<'END';
EOF!TAIL
sub writemain{
my(@exts) = @_;
my($pname);
my($dl) = canon('/','DynaLoader');
print $head;
foreach $_ (@exts){
my($pname) = canon('/', $_);
my($mname, $cname);
($mname = $pname) =~ s!/!::!g;
($cname = $pname) =~ s!/!__!g;
print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
}
my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
print $tail1;
print "\tconst char file[] = __FILE__;\n";
print "\tdXSUB_SYS;\n" if $] > 5.002;
foreach $_ (@exts){
my($pname) = canon('/', $_);
my($mname, $cname, $ccode);
($mname = $pname) =~ s!/!::!g;
($cname = $pname) =~ s!/!__!g;
print "\t{\n";
if ($pname eq $dl){
# Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
# boot_DynaLoader is called directly in DynaLoader.pm
$ccode = "\t/* DynaLoader is a special case */\n
\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
print $ccode unless $SEEN{$ccode}++;
} else {
$ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
print $ccode unless $SEEN{$ccode}++;
}
print "\t}\n";
}
print $tail2;
}
sub canon{
my($as, @ext) = @_;
foreach(@ext){
# might be X::Y or lib/auto/X/Y/Y.a
next if s!::!/!g;
s:^(lib|ext)/(auto/)?::;
s:/\w+\.\w+$::;
}
grep(s:/:$as:, @ext) if ($as ne '/');
@ext;
}
1;
__END__
=head1 NAME
ExtUtils::Miniperl, writemain - write the C code for perlmain.c
=head1 SYNOPSIS
C<use ExtUtils::Miniperl;>
C<writemain(@directories);>
=head1 DESCRIPTION
This whole module is written when perl itself is built from a script
called minimod.PL. In case you want to patch it, please patch
minimod.PL in the perl distribution instead.
writemain() takes an argument list of directories containing archive
libraries that relate to perl modules and should be linked into a new
perl binary. It writes to STDOUT a corresponding perlmain.c file that
is a plain C file containing all the bootstrap code to make the
modules associated with the libraries available from within perl.
The typical usage is from within a Makefile generated by
ExtUtils::MakeMaker. So under normal circumstances you won't have to
deal with this module directly.
=head1 SEE ALSO
L<ExtUtils::MakeMaker>
=cut
END
--- NEW FILE: perlapi.c ---
/* -*- buffer-read-only: t -*-
*
* perlapi.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by embed.pl from data in embed.fnc, embed.pl,
* pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
* Any changes made here will be lost!
*
* Edit those files and run 'make regen_headers' to effect changes.
*
*
* Up to the threshold of the door there mounted a flight of twenty-seven
* broad stairs, hewn by some unknown art of the same black stone. This
* was the only entrance to the tower.
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "perlapi.h"
#if defined (MULTIPLICITY)
/* accessor functions for Perl variables (provides binary compatibility) */
START_EXTERN_C
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
{ return &(aTHX->v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
{ return &(aTHX->v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
#include "thrdvar.h"
#include "intrpvar.h"
#undef PERLVAR
#undef PERLVARA
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
{ return &(PL_##v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
{ return &(PL_##v); }
#undef PERLVARIC
#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
{ return (const t *)&(PL_##v); }
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
END_EXTERN_C
#endif /* MULTIPLICITY */
/* ex: set ro: */
--- NEW FILE: pp.h ---
/* pp.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef USE_5005THREADS
#define ARGS thr
#define dARGS struct perl_thread *thr;
#else
#define ARGS
#define dARGS
#endif /* USE_5005THREADS */
#define PP(s) OP * Perl_##s(pTHX)
/*
=head1 Stack Manipulation Macros
=for apidoc AmU||SP
Stack pointer. This is usually handled by C<xsubpp>. See C<dSP> and
C<SPAGAIN>.
=for apidoc AmU||MARK
Stack marker variable for the XSUB. See C<dMARK>.
=for apidoc Am|void|PUSHMARK|SP
Opening bracket for arguments on a callback. See C<PUTBACK> and
L<perlcall>.
=for apidoc Ams||dSP
Declares a local copy of perl's stack pointer for the XSUB, available via
the C<SP> macro. See C<SP>.
=for apidoc ms||djSP
Declare Just C<SP>. This is actually identical to C<dSP>, and declares
a local copy of perl's stack pointer, available via the C<SP> macro.
See C<SP>. (Available for backward source code compatibility with the
old (Perl 5.005) thread model.)
=for apidoc Ams||dMARK
Declare a stack marker variable, C<mark>, for the XSUB. See C<MARK> and
C<dORIGMARK>.
=for apidoc Ams||dORIGMARK
Saves the original stack mark for the XSUB. See C<ORIGMARK>.
=for apidoc AmU||ORIGMARK
The original stack mark for the XSUB. See C<dORIGMARK>.
=for apidoc Ams||SPAGAIN
Refetch the stack pointer. Used after a callback. See L<perlcall>.
=cut */
#undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */
#define SP sp
#define MARK mark
#define TARG targ
#define PUSHMARK(p) \
STMT_START { \
if (++PL_markstack_ptr == PL_markstack_max) \
markstack_grow(); \
*PL_markstack_ptr = (p) - PL_stack_base; \
} STMT_END
#define TOPMARK (*PL_markstack_ptr)
#define POPMARK (*PL_markstack_ptr--)
#define dSP register SV **sp = PL_stack_sp
#define djSP dSP
#define dMARK register SV **mark = PL_stack_base + POPMARK
#define dORIGMARK const I32 origmark = mark - PL_stack_base
#define ORIGMARK (PL_stack_base + origmark)
#define SPAGAIN sp = PL_stack_sp
#define MSPAGAIN STMT_START { sp = PL_stack_sp; mark = ORIGMARK; } STMT_END
#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
#define dTARGETSTACKED SV * GETTARGETSTACKED
#define GETTARGET targ = PAD_SV(PL_op->op_targ)
#define dTARGET SV * GETTARGET
#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
#define dATARGET SV * GETATARGET
#define dTARG SV *targ
#define NORMAL PL_op->op_next
#define DIE return Perl_die
#ifndef PERL_CORE
# define DIE_NULL return DieNull
#endif
/*
=for apidoc Ams||PUTBACK
Closing bracket for XSUB arguments. This is usually handled by C<xsubpp>.
See C<PUSHMARK> and L<perlcall> for other uses.
=for apidoc Amn|SV*|POPs
Pops an SV off the stack.
=for apidoc Amn|char*|POPp
Pops a string off the stack. Deprecated. New code should use POPpx.
=for apidoc Amn|char*|POPpx
Pops a string off the stack.
=for apidoc Amn|char*|POPpbytex
Pops a string off the stack which must consist of bytes i.e. characters < 256.
=for apidoc Amn|NV|POPn
Pops a double off the stack.
=for apidoc Amn|IV|POPi
Pops an integer off the stack.
=for apidoc Amn|long|POPl
Pops a long off the stack.
=cut
*/
#define PUTBACK PL_stack_sp = sp
#define RETURN return PUTBACK, NORMAL
#define RETURNOP(o) return PUTBACK, o
#define RETURNX(x) return x, PUTBACK, NORMAL
#define POPs (*sp--)
#define POPp (SvPVx(POPs, PL_na)) /* deprecated */
#define POPpx (SvPVx_nolen(POPs))
#define POPpconstx (SvPVx_nolen_const(POPs))
#define POPpbytex (SvPVbytex_nolen(POPs))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define POPul ((unsigned long)SvIVx(POPs))
#ifdef HAS_QUAD
#define POPq ((Quad_t)SvIVx(POPs))
#define POPuq ((Uquad_t)SvUVx(POPs))
#endif
#define TOPs (*sp)
#define TOPm1s (*(sp-1))
#define TOPp1s (*(sp+1))
#define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
#define TOPpx (SvPV_nolen(TOPs))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
#define TOPu ((UV)SvUV(TOPs))
#define TOPl ((long)SvIV(TOPs))
#define TOPul ((unsigned long)SvUV(TOPs))
#ifdef HAS_QUAD
#define TOPq ((Quad_t)SvIV(TOPs))
#define TOPuq ((Uquad_t)SvUV(TOPs))
#endif
/* Go to some pains in the rare event that we must extend the stack. */
/*
=for apidoc Am|void|EXTEND|SP|int nitems
Used to extend the argument stack for an XSUB's return values. Once
used, guarantees that there is room for at least C<nitems> to be pushed
onto the stack.
=for apidoc Am|void|PUSHs|SV* sv
Push an SV onto the stack. The stack must have room for this element.
Does not handle 'set' magic. Does not use C<TARG>. See also C<PUSHmortal>,
C<XPUSHs> and C<XPUSHmortal>.
=for apidoc Am|void|PUSHp|char* str|STRLEN len
Push a string onto the stack. The stack must have room for this element.
The C<len> indicates the length of the string. Handles 'set' magic. Uses
C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to declare it. Do not
call multiple C<TARG>-oriented macros to return lists from XSUB's - see
C<mPUSHp> instead. See also C<XPUSHp> and C<mXPUSHp>.
=for apidoc Am|void|PUSHn|NV nv
Push a double onto the stack. The stack must have room for this element.
Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
called to declare it. Do not call multiple C<TARG>-oriented macros to
return lists from XSUB's - see C<mPUSHn> instead. See also C<XPUSHn> and
C<mXPUSHn>.
=for apidoc Am|void|PUSHi|IV iv
Push an integer onto the stack. The stack must have room for this element.
Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
called to declare it. Do not call multiple C<TARG>-oriented macros to
return lists from XSUB's - see C<mPUSHi> instead. See also C<XPUSHi> and
C<mXPUSHi>.
=for apidoc Am|void|PUSHu|UV uv
Push an unsigned integer onto the stack. The stack must have room for this
element. Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG>
should be called to declare it. Do not call multiple C<TARG>-oriented
macros to return lists from XSUB's - see C<mPUSHu> instead. See also
C<XPUSHu> and C<mXPUSHu>.
=for apidoc Am|void|XPUSHs|SV* sv
Push an SV onto the stack, extending the stack if necessary. Does not
handle 'set' magic. Does not use C<TARG>. See also C<XPUSHmortal>,
C<PUSHs> and C<PUSHmortal>.
=for apidoc Am|void|XPUSHp|char* str|STRLEN len
Push a string onto the stack, extending the stack if necessary. The C<len>
indicates the length of the string. Handles 'set' magic. Uses C<TARG>, so
C<dTARGET> or C<dXSTARG> should be called to declare it. Do not call
multiple C<TARG>-oriented macros to return lists from XSUB's - see
C<mXPUSHp> instead. See also C<PUSHp> and C<mPUSHp>.
=for apidoc Am|void|XPUSHn|NV nv
Push a double onto the stack, extending the stack if necessary. Handles
'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to
declare it. Do not call multiple C<TARG>-oriented macros to return lists
from XSUB's - see C<mXPUSHn> instead. See also C<PUSHn> and C<mPUSHn>.
=for apidoc Am|void|XPUSHi|IV iv
Push an integer onto the stack, extending the stack if necessary. Handles
'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to
declare it. Do not call multiple C<TARG>-oriented macros to return lists
from XSUB's - see C<mXPUSHi> instead. See also C<PUSHi> and C<mPUSHi>.
=for apidoc Am|void|XPUSHu|UV uv
Push an unsigned integer onto the stack, extending the stack if necessary.
Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
called to declare it. Do not call multiple C<TARG>-oriented macros to
return lists from XSUB's - see C<mXPUSHu> instead. See also C<PUSHu> and
C<mPUSHu>.
=for apidoc Am|void|PUSHmortal
Push a new mortal SV onto the stack. The stack must have room for this
element. Does not handle 'set' magic. Does not use C<TARG>. See also
C<PUSHs>, C<XPUSHmortal> and C<XPUSHs>.
=for apidoc Am|void|mPUSHp|char* str|STRLEN len
Push a string onto the stack. The stack must have room for this element.
The C<len> indicates the length of the string. Handles 'set' magic. Does
not use C<TARG>. See also C<PUSHp>, C<mXPUSHp> and C<XPUSHp>.
=for apidoc Am|void|mPUSHn|NV nv
Push a double onto the stack. The stack must have room for this element.
Handles 'set' magic. Does not use C<TARG>. See also C<PUSHn>, C<mXPUSHn>
and C<XPUSHn>.
=for apidoc Am|void|mPUSHi|IV iv
Push an integer onto the stack. The stack must have room for this element.
Handles 'set' magic. Does not use C<TARG>. See also C<PUSHi>, C<mXPUSHi>
and C<XPUSHi>.
=for apidoc Am|void|mPUSHu|UV uv
Push an unsigned integer onto the stack. The stack must have room for this
element. Handles 'set' magic. Does not use C<TARG>. See also C<PUSHu>,
C<mXPUSHu> and C<XPUSHu>.
=for apidoc Am|void|XPUSHmortal
Push a new mortal SV onto the stack, extending the stack if necessary. Does
not handle 'set' magic. Does not use C<TARG>. See also C<XPUSHs>,
C<PUSHmortal> and C<PUSHs>.
=for apidoc Am|void|mXPUSHp|char* str|STRLEN len
Push a string onto the stack, extending the stack if necessary. The C<len>
indicates the length of the string. Handles 'set' magic. Does not use
C<TARG>. See also C<XPUSHp>, C<mPUSHp> and C<PUSHp>.
=for apidoc Am|void|mXPUSHn|NV nv
Push a double onto the stack, extending the stack if necessary. Handles
'set' magic. Does not use C<TARG>. See also C<XPUSHn>, C<mPUSHn> and
C<PUSHn>.
=for apidoc Am|void|mXPUSHi|IV iv
Push an integer onto the stack, extending the stack if necessary. Handles
'set' magic. Does not use C<TARG>. See also C<XPUSHi>, C<mPUSHi> and
C<PUSHi>.
=for apidoc Am|void|mXPUSHu|UV uv
Push an unsigned integer onto the stack, extending the stack if necessary.
Handles 'set' magic. Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu>
and C<PUSHu>.
=cut
*/
#define EXTEND(p,n) STMT_START { if (PL_stack_max - p < (int)(n)) { \
sp = stack_grow(sp,p, (int) (n)); \
} } STMT_END
/* Same thing, but update mark register too. */
#define MEXTEND(p,n) STMT_START {if (PL_stack_max - p < (int)(n)) { \
const int markoff = mark - PL_stack_base; \
sp = stack_grow(sp,p,(int) (n)); \
mark = PL_stack_base + markoff; \
} } STMT_END
#define PUSHs(s) (*++sp = (s))
#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
#define PUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
#define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
#define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
#define XPUSHs(s) STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
#define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
#define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
#define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
#define PUSHmortal PUSHs(sv_newmortal())
#define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
#define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
#define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
#define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
#define XPUSHmortal XPUSHs(sv_newmortal())
#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
#define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
#define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
#define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
#define SETs(s) (*sp = s)
#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
#define SETn(n) STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
#define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
#define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
#define dTOPss SV *sv = TOPs
#define dPOPss SV *sv = POPs
#define dTOPnv NV value = TOPn
#define dPOPnv NV value = POPn
#define dTOPiv IV value = TOPi
#define dPOPiv IV value = POPi
#define dTOPuv UV value = TOPu
#define dPOPuv UV value = POPu
#ifdef HAS_QUAD
#define dTOPqv Quad_t value = TOPu
#define dPOPqv Quad_t value = POPu
#define dTOPuqv Uquad_t value = TOPuq
#define dPOPuqv Uquad_t value = POPuq
#endif
#define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s)
#define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n)
#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i)
#define USE_LEFT(sv) \
(SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
#define dPOPXnnrl_ul(X) \
NV right = POPn; \
SV *leftsv = CAT2(X,s); \
NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
#define dPOPXiirl_ul(X) \
IV right = POPi; \
SV *leftsv = CAT2(X,s); \
IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
#define dPOPPOPssrl dPOPXssrl(POP)
#define dPOPPOPnnrl dPOPXnnrl(POP)
#define dPOPPOPnnrl_ul dPOPXnnrl_ul(POP)
#define dPOPPOPiirl dPOPXiirl(POP)
#define dPOPPOPiirl_ul dPOPXiirl_ul(POP)
#define dPOPTOPssrl dPOPXssrl(TOP)
#define dPOPTOPnnrl dPOPXnnrl(TOP)
#define dPOPTOPnnrl_ul dPOPXnnrl_ul(TOP)
#define dPOPTOPiirl dPOPXiirl(TOP)
#define dPOPTOPiirl_ul dPOPXiirl_ul(TOP)
#define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes))
#define RETPUSHNO RETURNX(PUSHs(&PL_sv_no))
#define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef))
#define RETSETYES RETURNX(SETs(&PL_sv_yes))
#define RETSETNO RETURNX(SETs(&PL_sv_no))
#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef))
#define ARGTARG PL_op->op_targ
/* See OPpTARGET_MY: */
#define MAXARG (PL_op->op_private & 15)
#define SWITCHSTACK(f,t) \
STMT_START { \
AvFILLp(f) = sp - PL_stack_base; \
PL_stack_base = AvARRAY(t); \
PL_stack_max = PL_stack_base + AvMAX(t); \
sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \
PL_curstack = t; \
} STMT_END
#define EXTEND_MORTAL(n) \
STMT_START { \
if (PL_tmps_ix + (n) >= PL_tmps_max) \
tmps_grow(n); \
} STMT_END
#define AMGf_noright 1
#define AMGf_noleft 2
#define AMGf_assign 4
#define AMGf_unary 8
#define tryAMAGICbinW(meth,assign,set) STMT_START { \
if (PL_amagic_generation) { \
SV* tmpsv; \
SV* const right= *(sp); SV* const left= *(sp-1);\
if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
(tmpsv=amagic_call(left, \
right, \
CAT2(meth,_amg), \
(assign)? AMGf_assign: 0))) {\
SPAGAIN; \
(void)POPs; set(tmpsv); RETURN; } \
} \
} STMT_END
#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
#define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef, \
CAT2(meth,_amg),AMGf_noright | AMGf_unary)
#define AMG_CALLbinL(left,right,meth) \
amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
#define tryAMAGICunW(meth,set,shift,ret) STMT_START { \
if (PL_amagic_generation) { \
SV* tmpsv; \
SV* arg= sp[shift]; \
if(0) goto am_again; /* shut up unused warning */ \
am_again: \
if ((SvAMAGIC(arg))&&\
(tmpsv=AMG_CALLun(arg,meth))) {\
SPAGAIN; if (shift) sp += shift; \
set(tmpsv); ret; } \
} \
} STMT_END
#define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
#define tryAMAGICun(meth) tryAMAGICunW(meth,SETsvUN,0,RETURN)
#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
#define tryAMAGICunTARGET(meth, shift) \
STMT_START { dSP; sp--; /* get TARGET from below PL_stack_sp */ \
{ dTARGETSTACKED; \
{ dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}} STMT_END
#define setAGAIN(ref) \
STMT_START { \
sv = ref; \
if (!SvROK(ref)) \
Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); \
if (ref != arg && SvRV(ref) != SvRV(arg)) { \
arg = ref; \
goto am_again; \
} \
} STMT_END
#define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
#define opASSIGN (PL_op->op_flags & OPf_STACKED)
#define SETsv(sv) STMT_START { \
if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY)) \
{ sv_setsv(TARG, (sv)); SETTARG; } \
else SETs(sv); } STMT_END
#define SETsvUN(sv) STMT_START { \
if (SvFLAGS(TARG) & SVs_PADMY) \
{ sv_setsv(TARG, (sv)); SETTARG; } \
else SETs(sv); } STMT_END
/* newSVsv does not behave as advertised, so we copy missing
* information by hand */
/* SV* ref causes confusion with the member variable
changed SV* ref to SV* tmpRef */
#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \
if (SvREFCNT(tmpRef)>1) { \
SvRV_set(rv, AMG_CALLun(rv,copy)); \
SvREFCNT_dec(tmpRef); \
} } STMT_END
/*
=for apidoc mU||LVRET
True if this op will be the return value of an lvalue subroutine
=cut */
#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perly.fixer ---
#!/bin/sh
# Fix up yacc output to allow dynamic allocation. Since perly.c
# is now provided with the perl source, this should not be necessary.
#
# However, if the user wishes to use byacc, or wishes to try another
# compiler compiler (e.g. bison or yacc), this script will get run.
# See makefile run_byacc target for more details.
#
# Currently, only byacc version 1.8 is fully supported.
#
# Hacks to make it work with Interactive's SysVr3 Version 2.2
# doughera at lafayette.edu (Andy Dougherty) 3/23/91
#
# Additional information to make the BSD section work with SunOS 4.0.2
# tdinger at East.Sun.COM (Tom Dinger) 4/15/1991
#
# Also edit some practices gcc -Wall finds questionable.
#
gnupatch=patch
. ./config.sh
input=$1
output=$2
tmp=perly$$
inputh=`echo $input|sed 's:\.c$:.h:'`
if grep '^#ifdef PERL_CORE' $inputh; then
: never mind
else
echo "#ifdef PERL_CORE" > $tmp
sed -e 's:^typedef union {:#endif /* PERL_CORE */\
\
typedef union {:' $inputh >> $tmp
mv -f $tmp $inputh
fi
if grep 'yaccpar 1.8 (Berkeley)' $input >/dev/null 2>&1; then
cp $input $output
# Don't expect the diff to do everything -- do some by hand
if test -f perly_c.diff; then
$gnupatch -F3 $output <perly_c.diff
sed -e '/^[ ]*printf("yydebug:/s/printf(/PerlIO_printf(Perl_debug_log, /' \
-e '/^#line /s/"y[.]tab[.]c"/"perly.c"/' \
-e '/\[\] *= *[{]/s/^/static /' \
-e '/^static static/s/^static //' \
-e '/^#define.WORD/,/^#define.ARROW/d' \
-e '/^int.yydebug/,/^#define.yystacksize/d' \
-e 's/^yyerrlab:$//' \
-e 's/^ goto yyerrlab;//' \
-e 's/^yynewerror:$//' \
-e 's/^ goto yynewerror;//' \
-e 's|^static char yysccsid\(.*\)|/* static char yysccsid\1 */|' \
-e 's|deprecate(|deprecate_old(|' \
< $output > $tmp && mv -f $tmp $output || exit 1
rm -rf $input
echo "If you need to debug perly.c, you need to fix up the #line"
echo "directives yourself."
fi
exit
elif grep 'yaccpar 1.9 (Berkeley)' $input >/dev/null 2>&1; then
if test -f perly.c.dif9; then
$gnupatch -F3 $output <perly.c.dif9
sed -e '/^[ ]*printf("yydebug:/s/printf(/PerlIO_printf(Perl_debug_log, /' \
-e '/^#line /s/"y[.]tab[.]c"/"perly.c"/' \
-e '/\[\] *= *[{]/s/^/static /' \
-e '/^static static/s/^static //' \
-e '/^#define.WORD/,/^#define.ARROW/d' \
-e '/^int.yydebug/,/^#define.yystacksize/d' \
-e 's/^yyerrlab:$//' \
-e 's/^ goto yyerrlab;//' \
-e 's/^yynewerror:$//' \
-e 's/^ goto yynewerror;//' \
-e 's|^static char yysccsid\(.*\)|/* static char yysccsid\1 */|' \
-e 's|deprecate(|deprecate_old(|' \
< $output > $tmp && mv -f $tmp $output || exit 1
rm -rf $input
echo "If you need to debug perly.c, you need to fix up the #line"
echo "directives yourself."
exit 0
else
echo "Diffs from byacc-1.9 are not available."
echo "If you wish to proceed anyway, do"
echo "cp $input $output"
echo "cp y.tab.h perly.h"
echo "and re-run make. Otherwise, I will use the old perly.c"
touch perly.c
# Exit with error status to stop make.
exit 1
fi
fi
plan="unknown"
echo ""
echo "Warning: the yacc you have used is not directly supported by perl."
echo "The perly.fixer script will attempt to make some changes to the generated"
echo "file. The changes may be incomplete and that might lead to problems later"
echo "(especially with complex scripts). You may need to apply the changes"
echo "embedded in perl.fixer (and/or perly_c.dif*) by hand."
echo ""
# Below, we check for various characteristic yaccpar outputs.
# Test for BSD 4.3 version.
# Also tests for the SunOS 4.0.2 version
egrep 'YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];
short[ ]*yys\[ *YYMAXDEPTH *\] *;
yyps *= *&yys\[ *-1 *\];
yypv *= *&yyv\[ *-1 *\];
if *\( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp 2>/dev/null
set `wc -l $tmp`
if test "$1" = "5"; then
plan="bsd43"
fi
if test "$plan" = "unknown"; then
# Test for ISC 2.2 version (probably generic SysVr3).
egrep 'YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];
int[ ]*yys\[ *YYMAXDEPTH *\] *;
yyps *= *&yys\[ *-1 *\];
yypv *= *&yyv\[ *-1 *\];
if *\( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp 2>/dev/null
set `wc -l $tmp`
if test "$1" = "5"; then
plan="isc"
fi
fi
# ------
case "$plan" in
##################################################################
# The SunOS 4.0.2 version has the comparison fixed already.
# Also added are out of memory checks (makes porting the generated
# code easier) For most systems, it can't hurt. -- TD
"bsd43")
echo "Attempting to patch perly.c to allow dynamic yacc stack allocation"
echo "Assuming bsd4.3 yaccpar"
cat >$tmp <<'END'
/YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];/c\
int yymaxdepth = YYMAXDEPTH;\
YYSTYPE *yyv; /* where the values are stored */\
short *yys;\
short *maxyyps;
/short[ ]*yys\[ *YYMAXDEPTH *\] *;/d
/yyps *= *&yys\[ *-1 *\];/d
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
\ New(73, yyv, yymaxdepth, YYSTYPE);\
\ New(73, yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "out of memory" );\
\ return(1);\
\ }\
\ maxyyps = &yys[yymaxdepth];\
\ }\
\ yyps = &yys[-1];\
\ yypv = &yyv[-1];
/if *( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *)/c\
\ if( ++yyps >= maxyyps ) {\
\ int tv = yypv - yyv;\
\ int ts = yyps - yys;\
\
\ yymaxdepth *= 2;\
\ Renew(yyv, yymaxdepth, YYSTYPE);\
\ Renew(yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "yacc stack overflow" );\
\ return(1);\
\ }\
\ yyps = yys + ts;\
\ yypv = yyv + tv;\
\ maxyyps = &yys[yymaxdepth];\
\ }
/yacc stack overflow.*}/d
/yacc stack overflow/,/}/d
END
if sed -f $tmp <$input >$output
then echo "The edit seems to have been applied okay."
else echo "The edit seems to have failed!"
fi
;;
#######################################################
"isc") # Interactive Systems 2.2 version
echo "Attempting to patch perly.c to allow dynamic yacc stack allocation"
echo "Assuming Interactive SysVr3 2.2 yaccpar"
# Easier to simply put whole script here than to modify the
# bsd script with sed.
# Main changes: yaccpar sometimes uses yy_ps and yy_pv
# which are local register variables.
# if(++yyps > YYMAXDEPTH) had opening brace on next line.
# I've kept that brace in along with a call to yyerror if
# realloc fails. (Actually, I just don't know how to do
# multi-line matches in sed.)
cat > $tmp << 'END'
/YYSTYPE[ ]*yyv\[ *YYMAXDEPTH *\];/c\
int yymaxdepth = YYMAXDEPTH;\
YYSTYPE *yyv; /* where the values are stored */\
int *yys;\
int *maxyyps;
/int[ ]*yys\[ *YYMAXDEPTH *\] *;/d
/yyps *= *&yys\[ *-1 *\];/d
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
\ New(73, yyv, yymaxdepth, YYSTYPE);\
\ New(73, yys, yymaxdepth, int);\
\ maxyyps = &yys[yymaxdepth];\
\ }\
\ yyps = &yys[-1];\
\ yypv = &yyv[-1];
/if *( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *)/c\
\ if( ++yy_ps >= maxyyps ) {\
\ int tv = yy_pv - yyv;\
\ int ts = yy_ps - yys;\
\
\ yymaxdepth *= 2;\
\ Renew(yyv, yymaxdepth, YYSTYPE);\
\ Renew(yys, yymaxdepth, int);\
\ yy_ps = yyps = yys + ts;\
\ yy_pv = yypv = yyv + tv;\
\ maxyyps = &yys[yymaxdepth];\
\ }\
\ if (yyv == NULL || yys == NULL)
END
if sed -f $tmp < $input > $output
then echo "The edit seems to have been applied okay."
else echo "The edit seems to have failed!"
fi
;;
######################################################
# Plan still unknown
*)
echo "Unable to patch perly.c to allow dynamic yacc stack allocation (plan=$plan)"
# just do minimal change to write $output from $input
sed -e 's/Received token/ *** Received token/' $input >$output
;;
esac
echo ""
rm -rf $tmp $input
--- NEW FILE: warnings.pl ---
#!/usr/bin/perl
$VERSION = '1.02_02';
BEGIN {
push @INC, './lib';
}
use strict ;
sub DEFAULT_ON () { 1 }
sub DEFAULT_OFF () { 2 }
my $tree = {
'all' => [ 5.008, {
'io' => [ 5.008, {
'pipe' => [ 5.008, DEFAULT_OFF],
'unopened' => [ 5.008, DEFAULT_OFF],
'closed' => [ 5.008, DEFAULT_OFF],
'newline' => [ 5.008, DEFAULT_OFF],
'exec' => [ 5.008, DEFAULT_OFF],
'layer' => [ 5.008, DEFAULT_OFF],
}],
'syntax' => [ 5.008, {
'ambiguous' => [ 5.008, DEFAULT_OFF],
'semicolon' => [ 5.008, DEFAULT_OFF],
'precedence' => [ 5.008, DEFAULT_OFF],
'bareword' => [ 5.008, DEFAULT_OFF],
'reserved' => [ 5.008, DEFAULT_OFF],
'digit' => [ 5.008, DEFAULT_OFF],
'parenthesis' => [ 5.008, DEFAULT_OFF],
'printf' => [ 5.008, DEFAULT_OFF],
'prototype' => [ 5.008, DEFAULT_OFF],
'qw' => [ 5.008, DEFAULT_OFF],
}],
'severe' => [ 5.008, {
'inplace' => [ 5.008, DEFAULT_ON],
'internal' => [ 5.008, DEFAULT_ON],
'debugging' => [ 5.008, DEFAULT_ON],
'malloc' => [ 5.008, DEFAULT_ON],
}],
'deprecated' => [ 5.008, DEFAULT_OFF],
'void' => [ 5.008, DEFAULT_OFF],
'recursion' => [ 5.008, DEFAULT_OFF],
'redefine' => [ 5.008, DEFAULT_OFF],
'numeric' => [ 5.008, DEFAULT_OFF],
'uninitialized' => [ 5.008, DEFAULT_OFF],
'once' => [ 5.008, DEFAULT_OFF],
'misc' => [ 5.008, DEFAULT_OFF],
'regexp' => [ 5.008, DEFAULT_OFF],
'glob' => [ 5.008, DEFAULT_OFF],
'y2k' => [ 5.008, DEFAULT_OFF],
'untie' => [ 5.008, DEFAULT_OFF],
'substr' => [ 5.008, DEFAULT_OFF],
'taint' => [ 5.008, DEFAULT_OFF],
'signal' => [ 5.008, DEFAULT_OFF],
'closure' => [ 5.008, DEFAULT_OFF],
'overflow' => [ 5.008, DEFAULT_OFF],
'portable' => [ 5.008, DEFAULT_OFF],
'utf8' => [ 5.008, DEFAULT_OFF],
'exiting' => [ 5.008, DEFAULT_OFF],
'pack' => [ 5.008, DEFAULT_OFF],
'unpack' => [ 5.008, DEFAULT_OFF],
'threads' => [ 5.008, DEFAULT_OFF],
#'default' => [ 5.008, DEFAULT_ON ],
}],
} ;
###########################################################################
sub tab {
my($l, $t) = @_;
$t .= "\t" x ($l - (length($t) + 1) / 8);
$t;
}
###########################################################################
my %list ;
my %Value ;
my %ValueToName ;
my %NameToValue ;
my $index ;
my %v_list = () ;
sub valueWalk
{
my $tre = shift ;
my @list = () ;
my ($k, $v) ;
foreach $k (sort keys %$tre) {
$v = $tre->{$k};
die "duplicate key $k\n" if defined $list{$k} ;
die "Value associated with key '$k' is not an ARRAY reference"
if !ref $v || ref $v ne 'ARRAY' ;
my ($ver, $rest) = @{ $v } ;
push @{ $v_list{$ver} }, $k;
if (ref $rest)
{ valueWalk ($rest) }
}
}
sub orderValues
{
my $index = 0;
foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
foreach my $name (@{ $v_list{$ver} } ) {
$ValueToName{ $index } = [ uc $name, $ver ] ;
$NameToValue{ uc $name } = $index ++ ;
}
}
return $index ;
}
###########################################################################
sub walk
{
my $tre = shift ;
my @list = () ;
my ($k, $v) ;
foreach $k (sort keys %$tre) {
$v = $tre->{$k};
die "duplicate key $k\n" if defined $list{$k} ;
#$Value{$index} = uc $k ;
die "Can't find key '$k'"
if ! defined $NameToValue{uc $k} ;
push @{ $list{$k} }, $NameToValue{uc $k} ;
die "Value associated with key '$k' is not an ARRAY reference"
if !ref $v || ref $v ne 'ARRAY' ;
my ($ver, $rest) = @{ $v } ;
if (ref $rest)
{ push (@{ $list{$k} }, walk ($rest)) }
push @list, @{ $list{$k} } ;
}
return @list ;
}
###########################################################################
sub mkRange
{
my @a = @_ ;
my @out = @a ;
my $i ;
for ($i = 1 ; $i < @a; ++ $i) {
$out[$i] = ".."
if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
}
my $out = join(",", at out);
$out =~ s/,(\.\.,)+/../g ;
return $out;
}
###########################################################################
sub printTree
{
my $tre = shift ;
my $prefix = shift ;
my ($k, $v) ;
my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
my @keys = sort keys %$tre ;
while ($k = shift @keys) {
$v = $tre->{$k};
die "Value associated with key '$k' is not an ARRAY reference"
if !ref $v || ref $v ne 'ARRAY' ;
my $offset ;
if ($tre ne $tree) {
print $prefix . "|\n" ;
print $prefix . "+- $k" ;
$offset = ' ' x ($max + 4) ;
}
else {
print $prefix . "$k" ;
$offset = ' ' x ($max + 1) ;
}
my ($ver, $rest) = @{ $v } ;
if (ref $rest)
{
my $bar = @keys ? "|" : " ";
print " -" . "-" x ($max - length $k ) . "+\n" ;
printTree ($rest, $prefix . $bar . $offset )
}
else
{ print "\n" }
}
}
###########################################################################
sub mkHexOct
{
my ($f, $max, @a) = @_ ;
my $mask = "\x00" x $max ;
my $string = "" ;
foreach (@a) {
vec($mask, $_, 1) = 1 ;
}
foreach (unpack("C*", $mask)) {
if ($f eq 'x') {
$string .= '\x' . sprintf("%2.2x", $_)
}
else {
$string .= '\\' . sprintf("%o", $_)
}
}
return $string ;
}
sub mkHex
{
my($max, @a) = @_;
return mkHexOct("x", $max, @a);
}
sub mkOct
{
my($max, @a) = @_;
return mkHexOct("o", $max, @a);
}
###########################################################################
if (@ARGV && $ARGV[0] eq "tree")
{
printTree($tree, " ") ;
exit ;
}
unlink "warnings.h";
unlink "lib/warnings.pm";
open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
binmode WARN;
open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
binmode PM;
print WARN <<'EOM' ;
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by warnings.pl
Any changes made here will be lost!
*/
#define Off(x) ((x) / 8)
#define Bit(x) (1 << ((x) % 8))
#define IsSet(a, x) ((a)[Off(x)] & Bit(x))
#define G_WARN_OFF 0 /* $^W == 0 */
#define G_WARN_ON 1 /* -w flag and $^W != 0 */
#define G_WARN_ALL_ON 2 /* -W flag */
#define G_WARN_ALL_OFF 4 /* -X flag */
#define G_WARN_ONCE 8 /* set if 'once' ever enabled */
#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
#define pWARN_STD Nullsv
#define pWARN_ALL (Nullsv+1) /* use warnings 'all' */
#define pWARN_NONE (Nullsv+2) /* no warnings 'all' */
#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
(x) == pWARN_NONE)
EOM
my $offset = 0 ;
$index = $offset ;
#@{ $list{"all"} } = walk ($tree) ;
valueWalk ($tree) ;
my $index = orderValues();
die <<EOM if $index > 255 ;
Too many warnings categories -- max is 255
rewrite packWARN* & unpackWARN* macros
EOM
walk ($tree) ;
$index *= 2 ;
my $warn_size = int($index / 8) + ($index % 8 != 0) ;
my $k ;
my $last_ver = 0;
foreach $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
print WARN "\n/* Warnings Categories added in Perl $version */\n\n"
if $last_ver != $version ;
print WARN tab(5, "#define WARN_$name"), "$k\n" ;
$last_ver = $version ;
}
print WARN "\n" ;
print WARN tab(5, '#define WARNsize'), "$warn_size\n" ;
#print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
my $WARN_TAINTstring = mkOct($warn_size, map $_ * 2, @{ $list{'taint'} });
print WARN tab(5, '#define WARN_TAINTstring'), qq["$WARN_TAINTstring"\n] ;
print WARN <<'EOM';
#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet(SvPVX_const(c), 2*(x)))
#define isWARNf_on(c,x) (IsSet(SvPVX_const(c), 2*(x)+1))
#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
#define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
#define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
#define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
#define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
#define packWARN(a) (a )
#define packWARN2(a,b) ((a) | ((b)<<8) )
#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
#define unpackWARN1(x) ((x) & 0xFF)
#define unpackWARN2(x) (((x) >>8) & 0xFF)
#define unpackWARN3(x) (((x) >>16) & 0xFF)
#define unpackWARN4(x) (((x) >>24) & 0xFF)
#define ckDEAD(x) \
( ! specialWARN(PL_curcop->cop_warnings) && \
( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
/* end of file warnings.h */
/* ex: set ro: */
EOM
close WARN ;
while (<DATA>) {
last if /^KEYWORDS$/ ;
print PM $_ ;
}
#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
$last_ver = 0;
print PM "our %Offsets = (\n" ;
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
$name = lc $name;
$k *= 2 ;
if ( $last_ver != $version ) {
print PM "\n";
print PM tab(4, " # Warnings Categories added in Perl $version");
print PM "\n\n";
}
print PM tab(4, " '$name'"), "=> $k,\n" ;
$last_ver = $version;
}
print PM " );\n\n" ;
print PM "our %Bits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
print PM tab(4, " '$k'"), '=> "',
# mkHex($warn_size, @list),
mkHex($warn_size, map $_ * 2 , @list),
'", # [', mkRange(@list), "]\n" ;
}
print PM " );\n\n" ;
print PM "our %DeadBits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
print PM tab(4, " '$k'"), '=> "',
# mkHex($warn_size, @list),
mkHex($warn_size, map $_ * 2 + 1 , @list),
'", # [', mkRange(@list), "]\n" ;
}
print PM " );\n\n" ;
print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
print PM '$LAST_BIT = ' . "$index ;\n" ;
print PM '$BYTES = ' . "$warn_size ;\n" ;
while (<DATA>) {
print PM $_ ;
}
print PM "# ex: set ro:\n";
close PM ;
__END__
# -*- buffer-read-only: t -*-
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file was created by warnings.pl
# Any changes made here will be lost.
#
package warnings;
our $VERSION = '1.05';
=head1 NAME
warnings - Perl pragma to control optional warnings
=head1 SYNOPSIS
use warnings;
no warnings;
use warnings "all";
no warnings "all";
use warnings::register;
if (warnings::enabled()) {
warnings::warn("some warning");
}
if (warnings::enabled("void")) {
warnings::warn("void", "some warning");
}
if (warnings::enabled($object)) {
warnings::warn($object, "some warning");
}
warnings::warnif("some warning");
warnings::warnif("void", "some warning");
warnings::warnif($object, "some warning");
=head1 DESCRIPTION
The C<warnings> pragma is a replacement for the command line flag C<-w>,
but the pragma is limited to the enclosing block, while the flag is global.
See L<perllexwarn> for more information.
If no import list is supplied, all possible warnings are either enabled
or disabled.
A number of functions are provided to assist module authors.
=over 4
=item use warnings::register
Creates a new warnings category with the same name as the package where
the call to the pragma is used.
=item warnings::enabled()
Use the warnings category with the same name as the current package.
Return TRUE if that warnings category is enabled in the calling module.
Otherwise returns FALSE.
=item warnings::enabled($category)
Return TRUE if the warnings category, C<$category>, is enabled in the
calling module.
Otherwise returns FALSE.
=item warnings::enabled($object)
Use the name of the class for the object reference, C<$object>, as the
warnings category.
Return TRUE if that warnings category is enabled in the first scope
where the object is used.
Otherwise returns FALSE.
=item warnings::warn($message)
Print C<$message> to STDERR.
Use the warnings category with the same name as the current package.
If that warnings category has been set to "FATAL" in the calling module
then die. Otherwise return.
=item warnings::warn($category, $message)
Print C<$message> to STDERR.
If the warnings category, C<$category>, has been set to "FATAL" in the
calling module then die. Otherwise return.
=item warnings::warn($object, $message)
Print C<$message> to STDERR.
Use the name of the class for the object reference, C<$object>, as the
warnings category.
If that warnings category has been set to "FATAL" in the scope where C<$object>
is first used then die. Otherwise return.
=item warnings::warnif($message)
Equivalent to:
if (warnings::enabled())
{ warnings::warn($message) }
=item warnings::warnif($category, $message)
Equivalent to:
if (warnings::enabled($category))
{ warnings::warn($category, $message) }
=item warnings::warnif($object, $message)
Equivalent to:
if (warnings::enabled($object))
{ warnings::warn($object, $message) }
=back
See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
=cut
use Carp ();
KEYWORDS
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
sub Croaker
{
local $Carp::CarpInternal{'warnings'};
delete $Carp::CarpInternal{'warnings'};
Carp::croak(@_);
}
sub bits
{
# called from B::Deparse.pm
push @_, 'all' unless @_;
my $mask;
my $catmask ;
my $fatal = 0 ;
my $no_fatal = 0 ;
foreach my $word ( @_ ) {
if ($word eq 'FATAL') {
$fatal = 1;
$no_fatal = 0;
}
elsif ($word eq 'NONFATAL') {
$fatal = 0;
$no_fatal = 1;
}
elsif ($catmask = $Bits{$word}) {
$mask |= $catmask ;
$mask |= $DeadBits{$word} if $fatal ;
$mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
}
else
{ Croaker("Unknown warnings category '$word'")}
}
return $mask ;
}
sub import
{
shift;
my $catmask ;
my $fatal = 0 ;
my $no_fatal = 0 ;
my $mask = ${^WARNING_BITS} ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
}
push @_, 'all' unless @_;
foreach my $word ( @_ ) {
if ($word eq 'FATAL') {
$fatal = 1;
$no_fatal = 0;
}
elsif ($word eq 'NONFATAL') {
$fatal = 0;
$no_fatal = 1;
}
elsif ($catmask = $Bits{$word}) {
$mask |= $catmask ;
$mask |= $DeadBits{$word} if $fatal ;
$mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
}
else
{ Croaker("Unknown warnings category '$word'")}
}
${^WARNING_BITS} = $mask ;
}
sub unimport
{
shift;
my $catmask ;
my $mask = ${^WARNING_BITS} ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
}
push @_, 'all' unless @_;
foreach my $word ( @_ ) {
if ($word eq 'FATAL') {
next;
}
elsif ($catmask = $Bits{$word}) {
$mask &= ~($catmask | $DeadBits{$word} | $All);
}
else
{ Croaker("Unknown warnings category '$word'")}
}
${^WARNING_BITS} = $mask ;
}
my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
sub __chk
{
my $category ;
my $offset ;
my $isobj = 0 ;
if (@_) {
# check the category supplied.
$category = shift ;
if (my $type = ref $category) {
Croaker("not an object")
if exists $builtin_type{$type};
$category = $type;
$isobj = 1 ;
}
$offset = $Offsets{$category};
Croaker("Unknown warnings category '$category'")
unless defined $offset;
}
else {
$category = (caller(1))[0] ;
$offset = $Offsets{$category};
Croaker("package '$category' not registered for warnings")
unless defined $offset ;
}
my $this_pkg = (caller(1))[0] ;
my $i = 2 ;
my $pkg ;
if ($isobj) {
while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
}
$i -= 2 ;
}
else {
for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
last if $pkg ne $this_pkg ;
}
$i = 2
if !$pkg || $pkg eq $this_pkg ;
}
my $callers_bitmask = (caller($i))[9] ;
return ($callers_bitmask, $offset, $i) ;
}
sub enabled
{
Croaker("Usage: warnings::enabled([category])")
unless @_ == 1 || @_ == 0 ;
my ($callers_bitmask, $offset, $i) = __chk(@_) ;
return 0 unless defined $callers_bitmask ;
return vec($callers_bitmask, $offset, 1) ||
vec($callers_bitmask, $Offsets{'all'}, 1) ;
}
sub warn
{
Croaker("Usage: warnings::warn([category,] 'message')")
unless @_ == 2 || @_ == 1 ;
my $message = pop ;
my ($callers_bitmask, $offset, $i) = __chk(@_) ;
Carp::croak($message)
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
Carp::carp($message) ;
}
sub warnif
{
Croaker("Usage: warnings::warnif([category,] 'message')")
unless @_ == 2 || @_ == 1 ;
my $message = pop ;
my ($callers_bitmask, $offset, $i) = __chk(@_) ;
return
unless defined $callers_bitmask &&
(vec($callers_bitmask, $offset, 1) ||
vec($callers_bitmask, $Offsets{'all'}, 1)) ;
Carp::croak($message)
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
Carp::carp($message) ;
}
1;
--- NEW FILE: pp.c ---
/* pp.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "It's a big house this, and very peculiar. Always a bit more to discover,
* and no knowing what you'll find around a corner. And Elves, sir!" --Samwise
*/
/* This file contains general pp ("push/pop") functions that execute the
* opcodes that make up a perl program. A typical pp function expects to
* find its arguments on the stack, and usually pushes its results onto
* the stack, hence the 'pp' terminology. Each OP structure contains
[...4800 lines suppressed...]
EXTEND(SP, 1);
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(*save_threadsv(PL_op->op_targ));
else
PUSHs(THREADSV(PL_op->op_targ));
RETURN;
#else
DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
#endif /* USE_5005THREADS */
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perlapi.h ---
/* -*- buffer-read-only: t -*-
*
* perlapi.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by embed.pl from data in embed.fnc, embed.pl,
* pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
* Any changes made here will be lost!
*
* Edit those files and run 'make regen_headers' to effect changes.
*/
/* declare accessor functions for Perl variables */
[...1017 lines suppressed...]
#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL))
#undef PL_patleave
#define PL_patleave (*Perl_Gpatleave_ptr(NULL))
#undef PL_sh_path
#define PL_sh_path (*Perl_Gsh_path_ptr(NULL))
#undef PL_sigfpe_saved
#define PL_sigfpe_saved (*Perl_Gsigfpe_saved_ptr(NULL))
#undef PL_sv_placeholder
#define PL_sv_placeholder (*Perl_Gsv_placeholder_ptr(NULL))
#undef PL_thr_key
#define PL_thr_key (*Perl_Gthr_key_ptr(NULL))
#undef PL_use_safe_putenv
#define PL_use_safe_putenv (*Perl_Guse_safe_putenv_ptr(NULL))
#endif /* !PERL_CORE */
#endif /* MULTIPLICITY */
#endif /* __perlapi_h__ */
/* ex: set ro: */
--- NEW FILE: perly_c.diff ---
--- perly.c.orig Thu Apr 7 10:51:31 2005
+++ perly.c Thu Apr 7 10:54:13 2005
@@ -1,5 +1,5 @@
#ifndef lint
-static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
+/* static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; */
#endif
#define YYBYACC 1
#line 25 "perly.y"
@@ -9,7 +9,7 @@
#ifdef EBCDIC
#undef YYDEBUG
#endif
-#define dep() deprecate("\"do\" to call subroutines")
+#define dep() deprecate_old("\"do\" to call subroutines")
/* stuff included here to make perly_c.diff apply better */
@@ -50,70 +50,9 @@
#define yylex yylex_r
#endif
-#line 54 "y.tab.c"
-#define WORD 257
-#define METHOD 258
-#define FUNCMETH 259
-#define THING 260
-#define PMFUNC 261
-#define PRIVATEREF 262
-#define FUNC0SUB 263
-#define UNIOPSUB 264
-#define LSTOPSUB 265
-#define LABEL 266
-#define FORMAT 267
-#define SUB 268
-#define ANONSUB 269
-#define PACKAGE 270
-#define USE 271
-#define WHILE 272
-#define UNTIL 273
-#define IF 274
-#define UNLESS 275
-#define ELSE 276
-#define ELSIF 277
-#define CONTINUE 278
-#define FOR 279
-#define LOOPEX 280
-#define DOTDOT 281
-#define FUNC0 282
-#define FUNC1 283
-#define FUNC 284
-#define UNIOP 285
-#define LSTOP 286
-#define RELOP 287
-#define EQOP 288
-#define MULOP 289
-#define ADDOP 290
-#define DOLSHARP 291
-#define DO 292
-#define HASHBRACK 293
-#define NOAMP 294
-#define LOCAL 295
-#define MY 296
-#define MYSUB 297
-#define COLONATTR 298
-#define PREC_LOW 299
-#define OROP 300
-#define ANDOP 301
-#define NOTOP 302
-#define ASSIGNOP 303
-#define OROR 304
-#define ANDAND 305
-#define BITOROP 306
-#define BITANDOP 307
-#define SHIFTOP 308
-#define MATCHOP 309
-#define UMINUS 310
-#define REFGEN 311
-#define POWOP 312
-#define PREINC 313
-#define PREDEC 314
-#define POSTINC 315
-#define POSTDEC 316
-#define ARROW 317
+#line 54 "perly.c"
#define YYERRCODE 256
-short yylhs[] = { -1,
+static short yylhs[] = { -1,
0, 9, 7, 6, 10, 8, 11, 11, 11, 12,
12, 12, 12, 25, 25, 25, 25, 25, 25, 25,
15, 15, 15, 14, 14, 43, 43, 13, 13, 13,
@@ -135,7 +74,7 @@
49, 34, 34, 35, 35, 35, 44, 24, 19, 20,
21, 22, 23, 36, 36, 36, 36,
};
-short yylen[] = { 2,
+static short yylen[] = { 2,
2, 4, 0, 0, 4, 0, 0, 2, 2, 2,
1, 2, 3, 1, 1, 3, 3, 3, 3, 3,
0, 2, 6, 7, 7, 0, 2, 8, 8, 10,
@@ -157,7 +96,7 @@
1, 0, 1, 0, 1, 2, 1, 2, 2, 2,
2, 2, 2, 1, 1, 1, 1,
};
-short yydefred[] = { 4,
+static short yydefred[] = { 4,
0, 7, 0, 45, 58, 56, 0, 56, 56, 8,
46, 9, 11, 48, 0, 47, 49, 50, 0, 0,
0, 70, 71, 0, 14, 3, 173, 0, 0, 154,
@@ -199,7 +138,7 @@
0, 22, 0, 0, 0, 31, 5, 0, 30, 0,
0, 33, 0, 23,
};
-short yydgoto[] = { 1,
+static short yydgoto[] = { 1,
10, 11, 20, 104, 19, 2, 95, 370, 98, 359,
3, 12, 13, 70, 375, 285, 72, 73, 74, 75,
76, 77, 78, 79, 291, 81, 292, 281, 283, 286,
@@ -207,7 +146,7 @@
194, 327, 156, 289, 271, 225, 14, 83, 137, 84,
85, 86, 87, 15, 16, 17, 18, 93, 278,
};
-short yysindex[] = { 0,
+static short yysindex[] = { 0,
0, 0, -132, 0, 0, 0, -51, 0, 0, 0,
0, 0, 0, 0, 650, 0, 0, 0, -239, -215,
5, 0, 0, -215, 0, 0, 0, -31, -31, 0,
@@ -249,7 +188,7 @@
449, 0, 2181, -150, 340, 0, 0, 355, 0, 216,
216, 0, -123, 0,
};
-short yyrindex[] = { 0,
+static short yyrindex[] = { 0,
0, 0, 247, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 274, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -291,7 +230,7 @@
917, 0, 0, 119, 0, 0, 0, 0, 0, 0,
0, 0, 179, 0,
};
-short yygindex[] = { 0,
+static short yygindex[] = { 0,
0, 0, 196, 425, 0, 0, -2, 0, 37, 634,
-94, 0, 0, 0, -323, -15, 2445, 0, 999, 414,
417, 0, 0, 0, 463, -43, 0, 0, 321, -198,
@@ -300,7 +239,7 @@
0, 0, 0, 0, 0, 0, 0, 0, 0,
};
#define YYTABLESIZE 4568
-short yytable[] = { 71,
+static short yytable[] = { 71,
197, 65, 121, 227, 65, 111, 220, 22, 198, 293,
139, 296, 315, 275, 305, 102, 273, 88, 113, 228,
60, 113, 279, 65, 317, 60, 182, 254, 325, 101,
@@ -759,7 +698,7 @@
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 77, 77,
};
-short yycheck[] = { 15,
+static short yycheck[] = { 15,
95, 36, 46, 41, 36, 40, 59, 59, 100, 208,
54, 41, 59, 199, 41, 40, 196, 257, 41, 93,
123, 44, 202, 36, 93, 59, 40, 40, 59, 29,
@@ -1224,7 +1163,7 @@
#endif
#define YYMAXTOKEN 317
#if YYDEBUG
-char *yyname[] = {
+static char *yyname[] = {
"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
"'!'",0,0,"'$'","'%'","'&'",0,"'('","')'","'*'","'+'","','","'-'",0,0,0,0,0,0,0,
0,0,0,0,0,"':'","';'",0,0,0,"'?'","'@'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -1241,7 +1180,7 @@
"ANDAND","BITOROP","BITANDOP","SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP",
"PREINC","PREDEC","POSTINC","POSTDEC","ARROW",
};
-char *yyrule[] = {
+static char *yyrule[] = {
"$accept : prog",
"prog : progstart lineseq",
"block : '{' remember lineseq '}'",
@@ -1456,17 +1395,6 @@
#define YYMAXDEPTH 500
#endif
#endif
-int yydebug;
-int yynerrs;
-int yyerrflag;
-int yychar;
-short *yyssp;
-YYSTYPE *yyvsp;
-YYSTYPE yyval;
-YYSTYPE yylval;
-short yyss[YYSTACKSIZE];
-YYSTYPE yyvs[YYSTACKSIZE];
-#define yystacksize YYSTACKSIZE
#line 804 "perly.y"
/* PROGRAM */
@@ -1477,7 +1405,7 @@
#endif
#define yyparse() Perl_yyparse(pTHX)
-#line 1481 "y.tab.c"
+#line 1409 "perly.c"
#define YYABORT goto yyabort
#define YYACCEPT goto yyaccept
#define YYERROR goto yyerrlab
@@ -1485,11 +1413,31 @@
yyparse()
{
register int yym, yyn, yystate;
+ register short *yyssp;
+ register YYSTYPE *yyvsp;
+ short* yyss;
+ YYSTYPE* yyvs;
+ unsigned yystacksize = YYSTACKSIZE;
+ int retval = 0;
#if YYDEBUG
register char *yys;
- extern char *getenv();
+#endif
+
+ struct ysv *ysave;
+#ifdef USE_ITHREADS
+ ENTER; /* force yydestruct() before we return */
+#endif
+ New(73, ysave, 1, struct ysv);
+ SAVEDESTRUCTOR_X(yydestruct, ysave);
+ ysave->oldyydebug = yydebug;
+ ysave->oldyynerrs = yynerrs;
+ ysave->oldyyerrflag = yyerrflag;
+ ysave->oldyychar = yychar;
+ ysave->oldyyval = yyval;
+ ysave->oldyylval = yylval;
- if (yys = getenv("YYDEBUG"))
+#if YYDEBUG
+ if ((yys = getenv("YYDEBUG")))
{
yyn = *yys;
if (yyn >= '0' && yyn <= '9')
@@ -1501,12 +1449,22 @@
yyerrflag = 0;
yychar = (-1);
+ /*
+ ** Initialize private stacks (yyparse may be called from an action)
+ */
+ New(73, yyss, yystacksize, short);
+ New(73, yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = yyss;
+ ysave->yyvs = yyvs;
+ if (!yyvs || !yyss)
+ goto yyoverflow;
+
yyssp = yyss;
yyvsp = yyvs;
*yyssp = yystate = 0;
yyloop:
- if (yyn = yydefred[yystate]) goto yyreduce;
+ if ((yyn = yydefred[yystate])) goto yyreduce;
if (yychar < 0)
{
if ((yychar = yylex()) < 0) yychar = 0;
@@ -1516,7 +1474,7 @@
yys = 0;
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
- printf("yydebug: state %d, reading %d (%s)\n", yystate,
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate,
yychar, yys);
}
#endif
@@ -1526,12 +1484,24 @@
{
#if YYDEBUG
if (yydebug)
- printf("yydebug: state %d, shifting to state %d\n",
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n",
yystate, yytable[yyn]);
#endif
if (yyssp >= yyss + yystacksize - 1)
{
+ /*
+ ** reallocate and recover. Note that pointers
+ ** have to be reset, or bad things will happen
+ */
+ int yyps_index = (yyssp - yyss);
+ int yypv_index = (yyvsp - yyvs);
+ yystacksize += YYSTACKSIZE;
+ ysave->yyvs = Renew(yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = Renew(yyss, yystacksize, short);
+ if (!yyvs || !yyss)
goto yyoverflow;
+ yyssp = yyss + yyps_index;
+ yyvsp = yyvs + yypv_index;
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
@@ -1547,14 +1517,14 @@
}
if (yyerrflag) goto yyinrecovery;
#ifdef lint
- goto yynewerror;
+
#endif
-yynewerror:
+
yyerror("syntax error");
#ifdef lint
- goto yyerrlab;
+
#endif
-yyerrlab:
+
++yynerrs;
yyinrecovery:
if (yyerrflag < 3)
@@ -1567,12 +1537,24 @@
{
#if YYDEBUG
if (yydebug)
- printf("yydebug: state %d, error recovery shifting\
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, error recovery shifting\
to state %d\n", *yyssp, yytable[yyn]);
#endif
if (yyssp >= yyss + yystacksize - 1)
{
+ /*
+ ** reallocate and recover. Note that pointers
+ ** have to be reset, or bad things will happen
+ */
+ int yyps_index = (yyssp - yyss);
+ int yypv_index = (yyvsp - yyvs);
+ yystacksize += YYSTACKSIZE;
+ ysave->yyvs = Renew(yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = Renew(yyss, yystacksize, short);
+ if (!yyvs || !yyss)
goto yyoverflow;
+ yyssp = yyss + yyps_index;
+ yyvsp = yyvs + yypv_index;
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
@@ -1582,7 +1564,7 @@
{
#if YYDEBUG
if (yydebug)
- printf("yydebug: error recovery discarding state %d\n",
+ PerlIO_printf(Perl_debug_log, "yydebug: error recovery discarding state %d\n",
*yyssp);
#endif
if (yyssp <= yyss) goto yyabort;
@@ -1600,7 +1582,7 @@
yys = 0;
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
- printf("yydebug: state %d, error recovery discards token %d (%s)\n",
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, error recovery discards token %d (%s)\n",
yystate, yychar, yys);
}
#endif
@@ -1610,7 +1592,7 @@
yyreduce:
#if YYDEBUG
if (yydebug)
- printf("yydebug: state %d, reducing by rule %d (%s)\n",
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n",
yystate, yyn, yyrule[yyn]);
#endif
yym = yylen[yyn];
@@ -2485,7 +2467,7 @@
{
#if YYDEBUG
if (yydebug)
- printf("yydebug: after reduction, shifting from state 0 to\
+ PerlIO_printf(Perl_debug_log, "yydebug: after reduction, shifting from state 0 to\
state %d\n", YYFINAL);
#endif
yystate = YYFINAL;
@@ -2500,7 +2482,7 @@
yys = 0;
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
- printf("yydebug: state %d, reading %d (%s)\n",
+ PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n",
YYFINAL, yychar, yys);
}
#endif
@@ -2515,20 +2497,50 @@
yystate = yydgoto[yym];
#if YYDEBUG
if (yydebug)
- printf("yydebug: after reduction, shifting from state %d \
+ PerlIO_printf(Perl_debug_log, "yydebug: after reduction, shifting from state %d \
to state %d\n", *yyssp, yystate);
#endif
if (yyssp >= yyss + yystacksize - 1)
{
+ /*
+ ** reallocate and recover. Note that pointers
+ ** have to be reset, or bad things will happen
+ */
+ int yyps_index = (yyssp - yyss);
+ int yypv_index = (yyvsp - yyvs);
+ yystacksize += YYSTACKSIZE;
+ ysave->yyvs = Renew(yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = Renew(yyss, yystacksize, short);
+ if (!yyvs || !yyss)
goto yyoverflow;
+ yyssp = yyss + yyps_index;
+ yyvsp = yyvs + yypv_index;
}
*++yyssp = yystate;
*++yyvsp = yyval;
goto yyloop;
yyoverflow:
- yyerror("yacc stack overflow");
+ yyerror("Out of memory for yacc stack");
yyabort:
- return (1);
+ retval = 1;
yyaccept:
- return (0);
+#ifdef USE_ITHREADS
+ LEAVE; /* force yydestruct() before we return */
+#endif
+ return retval;
+}
+
+static void
+yydestruct(pTHX_ void *ptr)
+{
+ struct ysv* ysave = (struct ysv*)ptr;
+ if (ysave->yyss) Safefree(ysave->yyss);
+ if (ysave->yyvs) Safefree(ysave->yyvs);
+ yydebug = ysave->oldyydebug;
+ yynerrs = ysave->oldyynerrs;
+ yyerrflag = ysave->oldyyerrflag;
+ yychar = ysave->oldyychar;
+ yyval = ysave->oldyyval;
+ yylval = ysave->oldyylval;
+ Safefree(ysave);
}
--- NEW FILE: autodoc.pl ---
#!/usr/bin/perl -w
require 5.003; # keep this compatible, an old perl is all we may have before
# we build the new one
BEGIN {
push @INC, 'lib';
require 'regen_lib.pl';
}
#
# See database of global and static function prototypes in embed.fnc
# This is used to generate prototype headers under various configurations,
# export symbols lists for different platforms, and macros to provide an
# implicit interpreter context argument.
#
open IN, "embed.fnc" or die $!;
# walk table providing an array of components in each line to
# subroutine, printing the result
sub walk_table (&@) {
my $function = shift;
my $filename = shift || '-';
my $leader = shift;
my $trailer = shift;
my $F;
local *F;
if (ref $filename) { # filehandle
$F = $filename;
}
else {
safer_unlink $filename;
open F, ">$filename" or die "Can't open $filename: $!";
binmode F;
$F = \*F;
}
print $F $leader if $leader;
seek IN, 0, 0; # so we may restart
while (<IN>) {
chomp;
next if /^:/;
while (s|\\\s*$||) {
$_ .= <IN>;
chomp;
}
s/\s+$//;
my @args;
if (/^\s*(#|$)/) {
@args = $_;
}
else {
@args = split /\s*\|\s*/, $_;
}
s/\b(NN|NULLOK)\b\s+//g for @args;
print $F $function->(@args);
}
print $F $trailer if $trailer;
unless (ref $filename) {
close $F or die "Error closing $filename: $!";
}
}
my %apidocs;
my %gutsdocs;
my %docfuncs;
my $curheader = "Unknown section";
sub autodoc ($$) { # parse a file and extract documentation info
my($fh,$file) = @_;
my($in, $doc, $line);
FUNC:
while (defined($in = <$fh>)) {
if ($in=~ /^=head1 (.*)/) {
$curheader = $1;
next FUNC;
}
$line++;
if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
my $proto = $1;
$proto = "||$proto" unless $proto =~ /\|/;
my($flags, $ret, $name, @args) = split /\|/, $proto;
my $docs = "";
DOC:
while (defined($doc = <$fh>)) {
$line++;
last DOC if $doc =~ /^=\w+/;
if ($doc =~ m:^\*/$:) {
warn "=cut missing? $file:$line:$doc";;
last DOC;
}
$docs .= $doc;
}
$docs = "\n$docs" if $docs and $docs !~ /^\n/;
if ($flags =~ /m/) {
if ($flags =~ /A/) {
$apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
}
else {
$gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
}
}
else {
$docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
}
if (defined $doc) {
if ($doc =~ /^=(?:for|head)/) {
$in = $doc;
redo FUNC;
}
} else {
warn "$file:$line:$in";
}
}
}
}
sub docout ($$$) { # output the docs for one function
my($fh, $name, $docref) = @_;
my($flags, $docs, $ret, $file, @args) = @$docref;
$name =~ s/\s*$//;
$docs .= "NOTE: this function is experimental and may change or be
removed without notice.\n\n" if $flags =~ /x/;
$docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
if $flags =~ /p/;
print $fh "=item $name\nX<$name>\n$docs";
if ($flags =~ /U/) { # no usage
# nothing
} elsif ($flags =~ /s/) { # semicolon ("dTHR;")
print $fh "\t\t$name;\n\n";
} elsif ($flags =~ /n/) { # no args
print $fh "\t$ret\t$name\n\n";
} else { # full usage
print $fh "\t$ret\t$name";
print $fh "(" . join(", ", @args) . ")";
print $fh "\n\n";
}
print $fh "=for hackers\nFound in file $file\n\n";
}
my $file;
# glob() picks up docs from extra .c or .h files that may be in unclean
# development trees.
my $MANIFEST = do {
local ($/, *FH);
open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
<FH>;
};
for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
open F, "< $file" or die "Cannot open $file for docs: $!\n";
$curheader = "Functions in file $file\n";
autodoc(\*F,$file);
close F or die "Error closing $file: $!\n";
}
safer_unlink "pod/perlapi.pod";
open (DOC, ">pod/perlapi.pod") or
die "Can't create pod/perlapi.pod: $!\n";
binmode DOC;
walk_table { # load documented functions into approriate hash
if (@_ > 1) {
my($flags, $retval, $func, @args) = @_;
return "" unless $flags =~ /d/;
$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
$retval =~ s/\t//;
my $docref = delete $docfuncs{$func};
if ($docref and @$docref) {
if ($flags =~ /A/) {
$docref->[0].="x" if $flags =~ /M/;
$apidocs{$docref->[4]}{$func} =
[$docref->[0] . 'A', $docref->[1], $retval,
$docref->[3], @args];
} else {
$gutsdocs{$docref->[4]}{$func} =
[$docref->[0], $docref->[1], $retval, $docref->[3], @args];
}
}
else {
warn "no docs for $func\n" unless $docref and @$docref;
}
}
return "";
} \*DOC;
for (sort keys %docfuncs) {
# Have you used a full for apidoc or just a func name?
# Have you used Ap instead of Am in the for apidoc?
warn "Unable to place $_!\n";
}
print DOC <<'_EOB_';
=head1 NAME
perlapi - autogenerated documentation for the perl public API
=head1 DESCRIPTION
X<Perl API> X<API> X<api>
This file contains the documentation of the perl public API generated by
embed.pl, specifically a listing of functions, macros, flags, and variables
that may be used by extension writers. The interfaces of any functions that
are not listed here are subject to change without notice. For this reason,
blindly using functions listed in proto.h is to be avoided when writing
extensions.
Note that all Perl API global variables must be referenced with the C<PL_>
prefix. Some macros are provided for compatibility with the older,
unadorned names, but this support may be disabled in a future release.
The listing is alphabetical, case insensitive.
_EOB_
my $key;
# case insensitive sort, with fallback for determinacy
for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
my $section = $apidocs{$key};
print DOC "\n=head1 $key\n\n=over 8\n\n";
# Again, fallback for determinacy
for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
docout(\*DOC, $key, $section->{$key});
}
print DOC "\n=back\n";
}
print DOC <<'_EOE_';
=head1 AUTHORS
Until May 1997, this document was maintained by Jeff Okamoto
<okamoto at corp.hp.com>. It is now maintained as part of Perl itself.
With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
Stephen McCamant, and Gurusamy Sarathy.
API Listing originally by Dean Roehrich <roehrich at cray.com>.
Updated to be autogenerated from comments in the source by Benjamin Stuhl.
=head1 SEE ALSO
perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
_EOE_
close(DOC) or die "Error closing pod/perlapi.pod: $!";
safer_unlink "pod/perlintern.pod";
open(GUTS, ">pod/perlintern.pod") or
die "Unable to create pod/perlintern.pod: $!\n";
binmode GUTS;
print GUTS <<'END';
=head1 NAME
perlintern - autogenerated documentation of purely B<internal>
Perl functions
=head1 DESCRIPTION
X<internal Perl functions> X<interpreter functions>
This file is the autogenerated documentation of functions in the
Perl interpreter that are documented using Perl's internal documentation
format but are not marked as part of the Perl API. In other words,
B<they are not for use in extensions>!
END
for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
my $section = $gutsdocs{$key};
print GUTS "\n=head1 $key\n\n=over 8\n\n";
for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
docout(\*GUTS, $key, $section->{$key});
}
print GUTS "\n=back\n";
}
print GUTS <<'END';
=head1 AUTHORS
The autodocumentation system was originally added to the Perl core by
Benjamin Stuhl. Documentation is by whoever was kind enough to
document their functions.
=head1 SEE ALSO
perlguts(1), perlapi(1)
END
close GUTS or die "Error closing pod/perlintern.pod: $!";
--- NEW FILE: run.c ---
/* run.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* This file contains the main Perl opcode execution loop. It just
* calls the pp_foo() function associated with each op, and expects that
* function to return a pointer to the next op to be executed, or null if
* it's the end of the sub or program or whatever.
*
* There is a similar loop in dump.c, Perl_runops_debug(), which does
* the same, but also checks for various debug flags each time round the
* loop.
*
* Why this function requires a file all of its own is anybody's guess.
* DAPM.
*/
#include "EXTERN.h"
#define PERL_IN_RUN_C
#include "perl.h"
/*
* "Away now, Shadowfax! Run, greatheart, run as you have never run before!
* Now we are come to the lands where you were foaled, and every stone you
* know. Run now! Hope is in speed!" --Gandalf
*/
int
Perl_runops_standard(pTHX)
{
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
PERL_ASYNC_CHECK();
}
TAINT_NOT;
return 0;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: reentr.inc ---
/*
* reentr.inc
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by reentrl.pl from data in reentr.pl.
*/
#ifndef REENTRINC
#define REENTRINC
#ifdef USE_REENTRANT_API
/*
* As of OpenBSD 3.7, reentrant functions are now working, they just are
* incompatible with everyone else. To make OpenBSD happy, we have to
* memzero out certain structures before calling the functions.
[...1492 lines suppressed...]
#ifdef HAS_TTYNAME_R
# undef ttyname
# if !defined(ttyname) && TTYNAME_R_PROTO == REENTRANT_PROTO_I_IBW
# define ttyname(a) (ttyname_r(a, PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size) == 0 ? PL_reentrant_buffer->_ttyname_buffer : 0)
# endif
# if !defined(ttyname) && TTYNAME_R_PROTO == REENTRANT_PROTO_I_IBI
# define ttyname(a) (ttyname_r(a, PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size) == 0 ? PL_reentrant_buffer->_ttyname_buffer : 0)
# endif
# if !defined(ttyname) && TTYNAME_R_PROTO == REENTRANT_PROTO_B_IBI
# define ttyname(a) ttyname_r(a, PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size)
# endif
#endif /* HAS_TTYNAME_R */
#endif /* USE_REENTRANT_API */
#endif
/* ex: set ro: */
--- NEW FILE: keywords.pl ---
#!/usr/bin/perl
require 'regen_lib.pl';
safer_unlink ("keywords.h");
open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n";
binmode KW;
select KW;
print <<EOM;
/* -*- buffer-read-only: t -*-
*
* keywords.h
*
* Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2005,
* 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by keywords.pl from its data. Any changes made here
* will be lost!
*/
EOM
# Read & print data.
$keynum = 0;
while (<DATA>) {
chop;
next unless $_;
next if /^#/;
($keyword) = split;
print &tab(5, "#define KEY_$keyword"), $keynum++, "\n";
}
print KW "\n/* ex: set ro: */\n";
close KW or die "Error closing keywords.h: $!";
###########################################################################
sub tab {
local($l, $t) = @_;
$t .= "\t" x ($l - (length($t) + 1) / 8);
$t;
}
###########################################################################
__END__
NULL
__FILE__
__LINE__
__PACKAGE__
__DATA__
__END__
AUTOLOAD
BEGIN
CORE
DESTROY
END
INIT
CHECK
abs
accept
alarm
and
atan2
bind
binmode
bless
caller
chdir
chmod
chomp
chop
chown
chr
chroot
close
closedir
cmp
connect
continue
cos
crypt
dbmclose
dbmopen
defined
delete
die
do
dump
each
else
elsif
endgrent
endhostent
endnetent
endprotoent
endpwent
endservent
eof
eq
eval
exec
exists
exit
exp
fcntl
fileno
flock
for
foreach
fork
format
formline
ge
getc
getgrent
getgrgid
getgrnam
gethostbyaddr
gethostbyname
gethostent
getlogin
getnetbyaddr
getnetbyname
getnetent
getpeername
getpgrp
getppid
getpriority
getprotobyname
getprotobynumber
getprotoent
getpwent
getpwnam
getpwuid
getservbyname
getservbyport
getservent
getsockname
getsockopt
glob
gmtime
goto
grep
gt
hex
if
index
int
ioctl
join
keys
kill
last
lc
lcfirst
le
length
link
listen
local
localtime
lock
log
lstat
lt
m
map
mkdir
msgctl
msgget
msgrcv
msgsnd
my
ne
next
no
not
oct
open
opendir
or
ord
our
pack
package
pipe
pop
pos
print
printf
prototype
push
q
qq
qr
quotemeta
qw
qx
rand
read
readdir
readline
readlink
readpipe
recv
redo
ref
rename
require
reset
return
reverse
rewinddir
rindex
rmdir
s
scalar
seek
seekdir
select
semctl
semget
semop
send
setgrent
sethostent
setnetent
setpgrp
setpriority
setprotoent
setpwent
setservent
setsockopt
shift
shmctl
shmget
shmread
shmwrite
shutdown
sin
sleep
socket
socketpair
sort
splice
split
sprintf
sqrt
srand
stat
study
sub
substr
symlink
syscall
sysopen
sysread
sysseek
system
syswrite
tell
telldir
tie
tied
time
times
tr
truncate
uc
ucfirst
umask
undef
unless
unlink
unpack
unshift
untie
until
use
utime
values
vec
wait
waitpid
wantarray
warn
while
write
x
xor
y
--- NEW FILE: README.dgux ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
perldgux - Perl under DG/UX.
=head1 SYNOPSIS
One can read this document in the following formats:
man perldgux
view perl perldgux
explorer perldgux.html
info perldgux
to list some (not all may be available simultaneously), or it may
be read I<as is>: as F<README.dgux>.
=cut
Contents
perldgux - Perl under DG/UX.
NAME
SYNOPSIS
DESCRIPTION
BUILD
- Non-threaded Case
- Threaded Case
- Testing
- Installing the built perl
AUTHOR
SEE ALSO
=head1 DESCRIPTION
Perl 5.7/8.x for DG/UX ix86 R4.20MU0x
=head1 BUILDING PERL ON DG/UX
=head2 Non-threaded Perl on DG/UX
Just run ./Configure script from the top directory.
Then give "make" to compile.
=head2 Threaded Perl on DG/UX
If you are using as compiler GCC-2.95.x rev(DG/UX)
an easy solution for configuring perl in your DG/UX
machine is to run the command:
./Configure -Dusethreads -Duseithreads -Dusedevel -des
This will automatically accept all the defaults and
in particular /usr/local/ as installation directory.
Note that GCC-2.95.x rev(DG/UX) knows the switch
-pthread which allows it to link correctly DG/UX's
-lthread library.
If you want to change the installation directory or
have a standard DG/UX with C compiler GCC-2.7.2.x
then you have no choice than to do an interactive
build by issuing the command:
./Configure -Dusethreads -Duseithreads
In particular with GCC-2.7.2.x accept all the defaults
and *watch* out for the message:
Any additional ld flags (NOT including libraries)? [ -pthread]
Instead of -pthread put here -lthread. CGCC-2.7.2.x
that comes with the DG/UX OS does NOT know the -pthread
switch. So your build will fail if you choose the defaults.
After configuration is done correctly give "make" to compile.
=head2 Testing Perl on DG/UX
Issuing a "make test" will run all the tests.
If the test lib/ftmp-security gives you as a result
something like
lib/ftmp-security....File::Temp::_gettemp:
Parent directory (/tmp/) is not safe (sticky bit not set
when world writable?) at lib/ftmp-security.t line 100
don't panic and just set the sticky bit in your /tmp
directory by doing the following as root:
cd /
chmod +t /tmp (=set the sticky bit to /tmp).
Then rerun the tests. This time all must be OK.
=head2 Installing the built perl on DG/UX
Run the command "make install"
=head1 AUTHOR
Takis Psarogiannakopoulos
Universirty of Cambridge
Centre for Mathematical Sciences
Department of Pure Mathematics
Wilberforce road
Cambridge CB3 0WB , UK
email <takis at XFree86.Org>
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE: globvar.sym ---
# Global variables that must be exported for embedded applications.
# *** Do NOT add functions here, those go in global.sym.
# *** Only structures/arrays with constant initializers should go here.
# *** Usual globals initialized at runtime should be added in *var*.h.
AMG_names
block_type
check
fold
fold_locale
freq
memory_wrap
no_aelem
no_dir_func
no_func
no_helem
no_helem_sv
no_localize_ref
no_mem
no_modify
no_myglob
no_security
no_sock_func
no_symref
no_usym
no_wrongref
op_desc
op_name
opargs
ppaddr
regkind
sig_name
sig_num
simple
utf8skip
uuemap
varies
vtbl_amagic
vtbl_amagicelem
vtbl_arylen
vtbl_backref
vtbl_bm
vtbl_collxfrm
vtbl_dbline
vtbl_defelem
vtbl_env
vtbl_envelem
vtbl_fm
vtbl_glob
vtbl_isa
vtbl_isaelem
vtbl_mglob
vtbl_mutex
vtbl_nkeys
vtbl_pack
vtbl_packelem
vtbl_pos
vtbl_regdata
vtbl_regdatum
vtbl_regexp
vtbl_sig
vtbl_sigelem
vtbl_substr
vtbl_sv
vtbl_taint
vtbl_utf8
vtbl_uvar
vtbl_vec
warn_nl
warn_nosemi
warn_reserved
warn_uninit
--- NEW FILE: perlio.h ---
/* perlio.h
*
* Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifndef _PERLIO_H
#define _PERLIO_H
/*
Interface for perl to IO functions.
There is a hierarchy of Configure determined #define controls:
USE_STDIO - forces PerlIO_xxx() to be #define-d onto stdio functions.
This is used for x2p subdirectory and for conservative
builds - "just like perl5.00X used to be".
This dominates over the others.
USE_PERLIO - The primary Configure variable that enables PerlIO.
If USE_PERLIO is _NOT_ set
then USE_STDIO above will be set to be conservative.
If USE_PERLIO is set
then there are two modes determined by USE_SFIO:
USE_SFIO - If set causes PerlIO_xxx() to be #define-d onto sfio functions.
A backward compatability mode for some specialist applications.
If USE_SFIO is not set then PerlIO_xxx() are real functions
defined in perlio.c which implement extra functionality
required for utf8 support.
One further note - the table-of-functions scheme controlled
by PERL_IMPLICIT_SYS turns on USE_PERLIO so that iperlsys.h can
#define PerlIO_xxx() to go via the function table, without having
to #undef them from (say) stdio forms.
*/
#if defined(PERL_IMPLICIT_SYS)
#ifndef USE_PERLIO
#ifndef NETWARE
/* # define USE_PERLIO */
#endif
#endif
#endif
#ifndef USE_PERLIO
# define USE_STDIO
#endif
#ifdef USE_STDIO
# ifndef PERLIO_IS_STDIO
# define PERLIO_IS_STDIO
# endif
#endif
/* -------------------- End of Configure controls ---------------------------- */
/*
* Although we may not want stdio to be used including <stdio.h> here
* avoids issues where stdio.h has strange side effects
*/
#include <stdio.h>
#ifdef __BEOS__
int fseeko(FILE *stream, off_t offset, int whence);
off_t ftello(FILE *stream);
#endif
#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
#define ftell ftello
#endif
#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
#define fseek fseeko
#endif
/* BS2000 includes are sometimes a bit non standard :-( */
#if defined(POSIX_BC) && defined(O_BINARY) && !defined(O_TEXT)
#undef O_BINARY
#endif
#ifdef PERLIO_IS_STDIO
/* #define PerlIO_xxxx() as equivalent stdio function */
#include "perlsdio.h"
#else /* PERLIO_IS_STDIO */
#ifdef USE_SFIO
/* #define PerlIO_xxxx() as equivalent sfio function */
#include "perlsfio.h"
#endif /* USE_SFIO */
#endif /* PERLIO_IS_STDIO */
#ifndef PerlIO
/* ----------- PerlIO implementation ---------- */
/* PerlIO not #define-d to something else - define the implementation */
typedef struct _PerlIO PerlIOl;
typedef struct _PerlIO_funcs PerlIO_funcs;
typedef PerlIOl *PerlIO;
#define PerlIO PerlIO
#define PERLIO_LAYERS 1
/* Making the big PerlIO_funcs vtables const is good (enables placing
* them in the const section which is good for speed, security, and
* embeddability) but this cannot be done by default because of
* backward compatibility. */
#ifdef PERLIO_FUNCS_CONST
#define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
#define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
#else
#define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
#define PERLIO_FUNCS_CAST(funcs) (funcs)
#endif
PERL_EXPORT_C void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab);
PERL_EXPORT_C PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name,
STRLEN len,
int load);
PERL_EXPORT_C PerlIO *PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab),
const char *mode, SV *arg);
PERL_EXPORT_C void PerlIO_pop(pTHX_ PerlIO *f);
PERL_EXPORT_C AV* PerlIO_get_layers(pTHX_ PerlIO *f);
PERL_EXPORT_C void PerlIO_clone(pTHX_ PerlInterpreter *proto,
CLONE_PARAMS *param);
#endif /* PerlIO */
/* ----------- End of implementation choices ---------- */
#ifndef PERLIO_IS_STDIO
/* Not using stdio _directly_ as PerlIO */
/* We now need to determine what happens if source trys to use stdio.
* There are three cases based on PERLIO_NOT_STDIO which XS code
* can set how it wants.
*/
#ifdef PERL_CORE
/* Make a choice for perl core code
- currently this is set to try and catch lingering raw stdio calls.
This is a known issue with some non UNIX ports which still use
"native" stdio features.
*/
#ifndef PERLIO_NOT_STDIO
#define PERLIO_NOT_STDIO 1
#endif
#else
#ifndef PERLIO_NOT_STDIO
#define PERLIO_NOT_STDIO 0
#endif
#endif
#ifdef PERLIO_NOT_STDIO
#if PERLIO_NOT_STDIO
/*
* PERLIO_NOT_STDIO #define'd as 1
* Case 1: Strong denial of stdio - make all stdio calls (we can think of) errors
*/
#include "nostdio.h"
#else /* if PERLIO_NOT_STDIO */
/*
* PERLIO_NOT_STDIO #define'd as 0
* Case 2: Declares that both PerlIO and stdio can be used
*/
#endif /* if PERLIO_NOT_STDIO */
#else /* ifdef PERLIO_NOT_STDIO */
/*
* PERLIO_NOT_STDIO not defined
* Case 3: Try and fake stdio calls as PerlIO calls
*/
#include "fakesdio.h"
#endif /* ifndef PERLIO_NOT_STDIO */
#endif /* PERLIO_IS_STDIO */
#define specialCopIO(sv) ((sv) == Nullsv)
/* ----------- fill in things that have not got #define'd ---------- */
#ifndef Fpos_t
#define Fpos_t Off_t
#endif
#ifndef EOF
#define EOF (-1)
#endif
/* This is to catch case with no stdio */
#ifndef BUFSIZ
#define BUFSIZ 1024
#endif
#ifndef SEEK_SET
#define SEEK_SET 0
#endif
#ifndef SEEK_CUR
#define SEEK_CUR 1
#endif
#ifndef SEEK_END
#define SEEK_END 2
#endif
#define PERLIO_DUP_CLONE 1
#define PERLIO_DUP_FD 2
/* --------------------- Now prototypes for functions --------------- */
START_EXTERN_C
#ifndef __attribute__format__
# ifdef HASATTRIBUTE_FORMAT
# define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
# else
# define __attribute__format__(x,y,z)
# endif
#endif
#ifndef PerlIO_init
PERL_EXPORT_C void PerlIO_init(pTHX);
#endif
#ifndef PerlIO_stdoutf
PERL_EXPORT_C int PerlIO_stdoutf(const char *, ...)
__attribute__format__(__printf__, 1, 2);
#endif
#ifndef PerlIO_puts
PERL_EXPORT_C int PerlIO_puts(PerlIO *, const char *);
#endif
#ifndef PerlIO_open
PERL_EXPORT_C PerlIO *PerlIO_open(const char *, const char *);
#endif
#ifndef PerlIO_openn
PERL_EXPORT_C PerlIO *PerlIO_openn(pTHX_ const char *layers, const char *mode,
int fd, int imode, int perm, PerlIO *old,
int narg, SV **arg);
#endif
#ifndef PerlIO_eof
PERL_EXPORT_C int PerlIO_eof(PerlIO *);
#endif
#ifndef PerlIO_error
PERL_EXPORT_C int PerlIO_error(PerlIO *);
#endif
#ifndef PerlIO_clearerr
PERL_EXPORT_C void PerlIO_clearerr(PerlIO *);
#endif
#ifndef PerlIO_getc
PERL_EXPORT_C int PerlIO_getc(PerlIO *);
#endif
#ifndef PerlIO_putc
PERL_EXPORT_C int PerlIO_putc(PerlIO *, int);
#endif
#ifndef PerlIO_ungetc
PERL_EXPORT_C int PerlIO_ungetc(PerlIO *, int);
#endif
#ifndef PerlIO_fdopen
PERL_EXPORT_C PerlIO *PerlIO_fdopen(int, const char *);
#endif
#ifndef PerlIO_importFILE
PERL_EXPORT_C PerlIO *PerlIO_importFILE(FILE *, const char *);
#endif
#ifndef PerlIO_exportFILE
PERL_EXPORT_C FILE *PerlIO_exportFILE(PerlIO *, const char *);
#endif
#ifndef PerlIO_findFILE
PERL_EXPORT_C FILE *PerlIO_findFILE(PerlIO *);
#endif
#ifndef PerlIO_releaseFILE
PERL_EXPORT_C void PerlIO_releaseFILE(PerlIO *, FILE *);
#endif
#ifndef PerlIO_read
PERL_EXPORT_C SSize_t PerlIO_read(PerlIO *, void *, Size_t);
#endif
#ifndef PerlIO_unread
PERL_EXPORT_C SSize_t PerlIO_unread(PerlIO *, const void *, Size_t);
#endif
#ifndef PerlIO_write
PERL_EXPORT_C SSize_t PerlIO_write(PerlIO *, const void *, Size_t);
#endif
#ifndef PerlIO_setlinebuf
PERL_EXPORT_C void PerlIO_setlinebuf(PerlIO *);
#endif
#ifndef PerlIO_printf
PERL_EXPORT_C int PerlIO_printf(PerlIO *, const char *, ...)
__attribute__format__(__printf__, 2, 3);
#endif
#ifndef PerlIO_sprintf
PERL_EXPORT_C int PerlIO_sprintf(char *, int, const char *, ...)
__attribute__format__(__printf__, 3, 4);
#endif
#ifndef PerlIO_vprintf
PERL_EXPORT_C int PerlIO_vprintf(PerlIO *, const char *, va_list);
#endif
#ifndef PerlIO_tell
PERL_EXPORT_C Off_t PerlIO_tell(PerlIO *);
#endif
#ifndef PerlIO_seek
PERL_EXPORT_C int PerlIO_seek(PerlIO *, Off_t, int);
#endif
#ifndef PerlIO_rewind
PERL_EXPORT_C void PerlIO_rewind(PerlIO *);
#endif
#ifndef PerlIO_has_base
PERL_EXPORT_C int PerlIO_has_base(PerlIO *);
#endif
#ifndef PerlIO_has_cntptr
PERL_EXPORT_C int PerlIO_has_cntptr(PerlIO *);
#endif
#ifndef PerlIO_fast_gets
PERL_EXPORT_C int PerlIO_fast_gets(PerlIO *);
#endif
#ifndef PerlIO_canset_cnt
PERL_EXPORT_C int PerlIO_canset_cnt(PerlIO *);
#endif
#ifndef PerlIO_get_ptr
PERL_EXPORT_C STDCHAR *PerlIO_get_ptr(PerlIO *);
#endif
#ifndef PerlIO_get_cnt
PERL_EXPORT_C int PerlIO_get_cnt(PerlIO *);
#endif
#ifndef PerlIO_set_cnt
PERL_EXPORT_C void PerlIO_set_cnt(PerlIO *, int);
#endif
#ifndef PerlIO_set_ptrcnt
PERL_EXPORT_C void PerlIO_set_ptrcnt(PerlIO *, STDCHAR *, int);
#endif
#ifndef PerlIO_get_base
PERL_EXPORT_C STDCHAR *PerlIO_get_base(PerlIO *);
#endif
#ifndef PerlIO_get_bufsiz
PERL_EXPORT_C int PerlIO_get_bufsiz(PerlIO *);
#endif
#ifndef PerlIO_tmpfile
PERL_EXPORT_C PerlIO *PerlIO_tmpfile(void);
#endif
#ifndef PerlIO_stdin
PERL_EXPORT_C PerlIO *PerlIO_stdin(void);
#endif
#ifndef PerlIO_stdout
PERL_EXPORT_C PerlIO *PerlIO_stdout(void);
#endif
#ifndef PerlIO_stderr
PERL_EXPORT_C PerlIO *PerlIO_stderr(void);
#endif
#ifndef PerlIO_getpos
PERL_EXPORT_C int PerlIO_getpos(PerlIO *, SV *);
#endif
#ifndef PerlIO_setpos
PERL_EXPORT_C int PerlIO_setpos(PerlIO *, SV *);
#endif
#ifndef PerlIO_fdupopen
PERL_EXPORT_C PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *, int);
#endif
#if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO)
PERL_EXPORT_C char *PerlIO_modestr(PerlIO *, char *buf);
#endif
#ifndef PerlIO_isutf8
PERL_EXPORT_C int PerlIO_isutf8(PerlIO *);
#endif
#ifndef PerlIO_apply_layers
PERL_EXPORT_C int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode,
const char *names);
#endif
#ifndef PerlIO_binmode
PERL_EXPORT_C int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int omode,
const char *names);
#endif
#ifndef PerlIO_getname
PERL_EXPORT_C char *PerlIO_getname(PerlIO *, char *);
#endif
PERL_EXPORT_C void PerlIO_destruct(pTHX);
PERL_EXPORT_C int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
#ifdef PERLIO_LAYERS
PERL_EXPORT_C void PerlIO_cleanup(pTHX);
PERL_EXPORT_C void PerlIO_debug(const char *fmt, ...)
__attribute__format__(__printf__, 1, 2);
typedef struct PerlIO_list_s PerlIO_list_t;
#endif
END_EXTERN_C
#endif /* _PERLIO_H */
--- NEW FILE: Configure ---
#! /bin/sh
#
# If these # comments don't work, trim them. Don't worry about any other
# shell scripts, Configure will trim # comments from them for you.
#
# (If you are trying to port this package to a machine without sh,
# I would suggest you have a look at the prototypical config_h.SH file
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
# Yes, you may rip this off to use in other distribution packages. This
# script belongs to the public domain and cannot be copyrighted.
#
# (Note: this Configure script was generated automatically. Rather than
# working with this copy of Configure, you may wish to get metaconfig.
# The dist-3.0 package (which contains metaconfig) was posted in
# comp.sources.misc and is available on CPAN under authors/id/RAM so
# you may fetch it yourself from your nearest archive site.)
#
[...22061 lines suppressed...]
$cat <<EOM
If you compile $package on a different machine or from a different object
directory, copy the Policy.sh file from this object directory to the
new one before you run Configure -- this will help you with most of
the policy defaults.
EOM
fi
if $test -f config.msg; then
echo "Hmm. I also noted the following information while running:"
echo " "
$cat config.msg >&4
$rm -f config.msg
fi
$rm -f kit*isdone ark*isdone
$rm -rf UU
: End of Configure
--- NEW FILE: configure.com ---
$! OpenVMS configuration procedure for Perl -- do not attempt to run under DOS
$ sav_ver = 'F$VERIFY(0)'
$ on control_y then goto clean_up
$! SET VERIFY
$!
$! For example, if you unpacked perl into: [USER.PERL-5n...] then you will
$! want to cd into the tree and execute Configure:
$!
$! $ SET DEFAULT [USER.PERL5_xxx]
$! $ @Configure
$!
$! or
$!
$! $ SET DEFAULT [USER.PERL5_xxx]
$! $ @Configure "-des"
$!
$! That's it. If you get into a bind trying to build perl on VMS then
$! definitely read through the README.VMS file.
$! Beyond that send email to vmsperl at perl.org
[...7025 lines suppressed...]
$ IF (silent)
$ THEN
$ CLOSE/NOLOG STDOUT
$ DEASSIGN SYS$OUTPUT
$ ENDIF
$ CLOSE/NOLOG CONFIG
$ IF F$GETJPI("","FILCNT").GT.vms_filcnt
$ THEN WRITE SYS$ERROR "%Config-W-VMS, WARNING: There is a file still open"
$ ENDIF
$ dflt = F$ENVIRONMENT("DEFAULT")
$ IF F$LOCATE("UU]",dflt).EQS.(F$LENGTH(dflt)-3)
$ THEN
$ IF ( F$SEARCH("[]*.*").NES."" ) THEN DELETE/NOLOG/NOCONFIRM []*.*;*
$ SET DEFAULT [-]
$ SET PROTECTION=(SYSTEM:RWED,OWNER:RWED) UU.DIR
$ DELETE/NOLOG/NOCONFIRM UU.DIR;
$ ENDIF
$ SET DEFAULT 'vms_default_directory_name' !be kind rewind
$ EXIT
$!: End of Configure
--- NEW FILE: Changes ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...8081 lines suppressed...]
____________________________________________________________________________
[ 24647] By: nicholas on 2005/05/31 10:31:56
Log: Disarm the maint branch
Branch: maint-5.8/perl
! patchlevel.h
____________________________________________________________________________
[ 24641] By: nicholas on 2005/05/30 21:22:34
Log: Break a leg
Branch: maint-5.8/perl
! patchlevel.h
____________________________________________________________________________
[ 24640] By: nicholas on 2005/05/30 21:22:04
Log: Sic transit unicos mundi
Branch: maint-5.8/perl
! pod/perl587delta.pod
____________________________________________________________________________
[ 24639] By: nicholas on 2005/05/30 21:06:23
Log: Update Changes
Branch: maint-5.8/perl
! Changes patchlevel.h
--- NEW FILE: perlio.c ---
/*
* perlio.c Copyright (c) 1996-2006, Nick Ing-Simmons You may distribute
* under the terms of either the GNU General Public License or the
* Artistic License, as specified in the README file.
*/
/*
* Hour after hour for nearly three weary days he had jogged up and down,
* over passes, and through long dales, and across many streams.
*/
/* This file contains the functions needed to implement PerlIO, which
* is Perl's private replacement for the C stdio library. This is used
* by default unless you compile with -Uuseperlio or run with
* PERLIO=:stdio (but don't do this unless you know what you're doing)
*/
/*
* If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
[...5074 lines suppressed...]
PerlIO_sprintf(char *s, int n, const char *fmt, ...)
{
va_list ap;
int result;
va_start(ap, fmt);
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;
}
#endif
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: nostdio.h ---
/* nostdio.h
*
* Copyright (C) 1996, 2000, 2001, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Strong denial of stdio - make all stdio calls (we can think of) errors
*/
/* This is a 1st attempt to stop other include files pulling
in real <stdio.h>.
A more ambitious set of possible symbols can be found in
sfio.h (inside an _cplusplus gard).
It is completely pointless as we have already included it ourselves.
*/
#if !defined(_STDIO_H) && !defined(FILE) && !defined(_STDIO_INCLUDED) && !defined(__STDIO_LOADED)
#define _STDIO_H
#define _STDIO_INCLUDED
#define __STDIO_LOADED
struct _FILE;
#define FILE struct _FILE
#endif
#define _CANNOT "CANNOT"
#undef clearerr
#undef fclose
#undef fdopen
#undef feof
#undef ferror
#undef fflush
#undef fgetc
#undef fgetpos
#undef fgets
#undef fileno
#undef flockfile
#undef fopen
#undef fprintf
#undef fputc
#undef fputs
#undef fread
#undef freopen
#undef fscanf
#undef fseek
#undef fsetpos
#undef ftell
#undef ftrylockfile
#undef funlockfile
#undef fwrite
#undef getc
#undef getc_unlocked
#undef getw
#undef pclose
#undef popen
#undef putc
#undef putc_unlocked
#undef putw
#undef rewind
#undef setbuf
#undef setvbuf
#undef stderr
#undef stdin
#undef stdout
#undef tmpfile
#undef ungetc
#undef vfprintf
#undef printf
#define fprintf _CANNOT _fprintf_
#define printf _CANNOT _printf_
#define stdin _CANNOT _stdin_
#define stdout _CANNOT _stdout_
#define stderr _CANNOT _stderr_
#ifndef OS2
#define tmpfile() _CANNOT _tmpfile_
#endif
#define fclose(f) _CANNOT _fclose_
#define fflush(f) _CANNOT _fflush_
#define fopen(p,m) _CANNOT _fopen_
#define freopen(p,m,f) _CANNOT _freopen_
#define setbuf(f,b) _CANNOT _setbuf_
#define setvbuf(f,b,x,s) _CANNOT _setvbuf_
#define fscanf _CANNOT _fscanf_
#define vfprintf(f,fmt,a) _CANNOT _vfprintf_
#define fgetc(f) _CANNOT _fgetc_
#define fgets(s,n,f) _CANNOT _fgets_
#define fputc(c,f) _CANNOT _fputc_
#define fputs(s,f) _CANNOT _fputs_
#define getc(f) _CANNOT _getc_
#define putc(c,f) _CANNOT _putc_
#ifndef OS2
#define ungetc(c,f) _CANNOT _ungetc_
#endif
#define fread(b,s,c,f) _CANNOT _fread_
#define fwrite(b,s,c,f) _CANNOT _fwrite_
#define fgetpos(f,p) _CANNOT _fgetpos_
#define fseek(f,o,w) _CANNOT _fseek_
#define fsetpos(f,p) _CANNOT _fsetpos_
#define ftell(f) _CANNOT _ftell_
#define rewind(f) _CANNOT _rewind_
#define clearerr(f) _CANNOT _clearerr_
#define feof(f) _CANNOT _feof_
#define ferror(f) _CANNOT _ferror_
#define __filbuf(f) _CANNOT __filbuf_
#define __flsbuf(c,f) _CANNOT __flsbuf_
#define _filbuf(f) _CANNOT _filbuf_
#define _flsbuf(c,f) _CANNOT _flsbuf_
#define fdopen(fd,p) _CANNOT _fdopen_
#define fileno(f) _CANNOT _fileno_
#if defined(SFIO_VERSION) && SFIO_VERSION < 20000101L
#define flockfile(f) _CANNOT _flockfile_
#define ftrylockfile(f) _CANNOT _ftrylockfile_
#define funlockfile(f) _CANNOT _funlockfile_
#endif
#define getc_unlocked(f) _CANNOT _getc_unlocked_
#define putc_unlocked(c,f) _CANNOT _putc_unlocked_
#define popen(c,m) _CANNOT _popen_
#define getw(f) _CANNOT _getw_
#define putw(v,f) _CANNOT _putw_
#ifndef OS2
#define pclose(f) _CANNOT _pclose_
#endif
--- NEW FILE: README.bs2000 ---
This document is written in pod format hence there are punctuation
characters in odd places. Do not worry, you've apparently got the
ASCII->EBCDIC translation worked out correctly. You can read more
about pod in pod/perlpod.pod or the short summary in the INSTALL file.
=head1 NAME
README.BS2000 - building and installing Perl for BS2000.
=head1 SYNOPSIS
This document will help you Configure, build, test and install Perl
on BS2000 in the POSIX subsystem.
=head1 DESCRIPTION
This is a ported perl for the POSIX subsystem in BS2000 VERSION OSD
V3.1A or later. It may work on other versions, but we started porting
and testing it with 3.1A and are currently using Version V4.0A.
You may need the following GNU programs in order to install perl:
=head2 gzip on BS2000
We used version 1.2.4, which could be installed out of the box with
one failure during 'make check'.
=head2 bison on BS2000
The yacc coming with BS2000 POSIX didn't work for us. So we had to
use bison. We had to make a few changes to perl in order to use the
pure (reentrant) parser of bison. We used version 1.25, but we had to
add a few changes due to EBCDIC. See below for more details
concerning yacc.
=head2 Unpacking Perl Distribution on BS2000
To extract an ASCII tar archive on BS2000 POSIX you need an ASCII
filesystem (we used the mountpoint /usr/local/ascii for this). Now
you extract the archive in the ASCII filesystem without
I/O-conversion:
cd /usr/local/ascii
export IO_CONVERSION=NO
gunzip < /usr/local/src/perl.tar.gz | pax -r
You may ignore the error message for the first element of the archive
(this doesn't look like a tar archive / skipping to next file...),
it's only the directory which will be created automatically anyway.
After extracting the archive you copy the whole directory tree to your
EBCDIC filesystem. B<This time you use I/O-conversion>:
cd /usr/local/src
IO_CONVERSION=YES
cp -r /usr/local/ascii/perl5.005_02 ./
=head2 Compiling Perl on BS2000
There is a "hints" file for BS2000 called hints.posix-bc (because
posix-bc is the OS name given by `uname`) that specifies the correct
values for most things. The major problem is (of course) the EBCDIC
character set. We have german EBCDIC version.
Because of our problems with the native yacc we used GNU bison to
generate a pure (=reentrant) parser for perly.y. So our yacc is
really the following script:
-----8<-----/usr/local/bin/yacc-----8<-----
#! /usr/bin/sh
# Bison as a reentrant yacc:
# save parameters:
params=""
while [[ $# -gt 1 ]]; do
params="$params $1"
shift
done
# add flag %pure_parser:
tmpfile=/tmp/bison.$$.y
echo %pure_parser > $tmpfile
cat $1 >> $tmpfile
# call bison:
echo "/usr/local/bin/bison --yacc $params $1\t\t\t(Pure Parser)"
/usr/local/bin/bison --yacc $params $tmpfile
# cleanup:
rm -f $tmpfile
-----8<----------8<-----
We still use the normal yacc for a2p.y though!!! We made a softlink
called byacc to distinguish between the two versions:
ln -s /usr/bin/yacc /usr/local/bin/byacc
We build perl using GNU make. We tried the native make once and it
worked too.
=head2 Testing Perl on BS2000
We still got a few errors during C<make test>. Some of them are the
result of using bison. Bison prints I<parser error> instead of I<syntax
error>, so we may ignore them. The following list shows
our errors, your results may differ:
op/numconvert.......FAILED tests 1409-1440
op/regexp...........FAILED tests 483, 496
op/regexp_noamp.....FAILED tests 483, 496
pragma/overload.....FAILED tests 152-153, 170-171
pragma/warnings.....FAILED tests 14, 82, 129, 155, 192, 205, 207
lib/bigfloat........FAILED tests 351-352, 355
lib/bigfltpm........FAILED tests 354-355, 358
lib/complex.........FAILED tests 267, 487
lib/dumper..........FAILED tests 43, 45
Failed 11/231 test scripts, 95.24% okay. 57/10595 subtests failed, 99.46% okay.
=head2 Installing Perl on BS2000
We have no nroff on BS2000 POSIX (yet), so we ignored any errors while
installing the documentation.
=head2 Using Perl in the Posix-Shell of BS2000
BS2000 POSIX doesn't support the shebang notation
(C<#!/usr/local/bin/perl>), so you have to use the following lines
instead:
: # use perl
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
=head2 Using Perl in "native" BS2000
We don't have much experience with this yet, but try the following:
Copy your Perl executable to a BS2000 LLM using bs2cp:
C<bs2cp /usr/local/bin/perl 'bs2:perl(perl,l)'>
Now you can start it with the following (SDF) command:
C</START-PROG FROM-FILE=*MODULE(PERL,PERL),PROG-MODE=*ANY,RUN-MODE=*ADV>
First you get the BS2000 commandline prompt ('*'). Here you may enter
your parameters, e.g. C<-e 'print "Hello World!\\n";'> (note the
double backslash!) or C<-w> and the name of your Perl script.
Filenames starting with C</> are searched in the Posix filesystem,
others are searched in the BS2000 filesystem. You may even use
wildcards if you put a C<%> in front of your filename (e.g. C<-w
checkfiles.pl %*.c>). Read your C/C++ manual for additional
possibilities of the commandline prompt (look for
PARAMETER-PROMPTING).
=head2 Floating point anomalies on BS2000
There appears to be a bug in the floating point implementation on BS2000 POSIX
systems such that calling int() on the product of a number and a small
magnitude number is not the same as calling int() on the quotient of
that number and a large magnitude number. For example, in the following
Perl code:
my $x = 100000.0;
my $y = int($x * 1e-5) * 1e5; # '0'
my $z = int($x / 1e+5) * 1e5; # '100000'
print "\$y is $y and \$z is $z\n"; # $y is 0 and $z is 100000
Although one would expect the quantities $y and $z to be the same and equal
to 100000 they will differ and instead will be 0 and 100000 respectively.
=head2 Using PerlIO and different encodings on ASCII and EBCDIC partitions
Since version 5.8 Perl uses the new PerlIO on BS2000. This enables
you using different encodings per IO channel. For example you may use
use Encode;
open($f, ">:encoding(ascii)", "test.ascii");
print $f "Hello World!\n";
open($f, ">:encoding(posix-bc)", "test.ebcdic");
print $f "Hello World!\n";
open($f, ">:encoding(latin1)", "test.latin1");
print $f "Hello World!\n";
open($f, ">:encoding(utf8)", "test.utf8");
print $f "Hello World!\n";
to get two files containing "Hello World!\n" in ASCII, EBCDIC, ISO
Latin-1 (in this example identical to ASCII) respective UTF-EBCDIC (in
this example identical to normal EBCDIC). See the documentation of
Encode::PerlIO for details.
As the PerlIO layer uses raw IO internally, all this totally ignores
the type of your filesystem (ASCII or EBCDIC) and the IO_CONVERSION
environment variable. If you want to get the old behavior, that the
BS2000 IO functions determine conversion depending on the filesystem
PerlIO still is your friend. You use IO_CONVERSION as usual and tell
Perl, that it should use the native IO layer:
export IO_CONVERSION=YES
export PERLIO=stdio
Now your IO would be ASCII on ASCII partitions and EBCDIC on EBCDIC
partitions. See the documentation of PerlIO (without C<Encode::>!)
for further posibilities.
=head1 AUTHORS
Thomas Dorner
=head1 SEE ALSO
L<INSTALL>, L<perlport>.
=head2 Mailing list
If you are interested in the VM/ESA, z/OS (formerly known as OS/390)
and POSIX-BC (BS2000) ports of Perl then see the perl-mvs mailing list.
To subscribe, send an empty message to perl-mvs-subscribe at perl.org.
See also:
http://lists.perl.org/showlist.cgi?name=perl-mvs
There are web archives of the mailing list at:
http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/
http://archive.develooper.com/perl-mvs@perl.org/
=head1 HISTORY
This document was originally written by Thomas Dorner for the 5.005
release of Perl.
This document was podified for the 5.6 release of perl 11 July 2000.
=cut
--- NEW FILE: patchlevel.h ---
/* patchlevel.h
*
* Copyright (C) 1993, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifndef __PATCHLEVEL_H_INCLUDED__
/* do not adjust the whitespace! Configure expects the numbers to be
* exactly on the third column */
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 8 /* epoch */
#define PERL_SUBVERSION 8 /* generation */
/* The following numbers describe the earliest compatible version of
Perl ("compatibility" here being defined as sufficient binary/API
compatibility to run XS code built with the older version).
Normally this should not change across maintenance releases.
Note that this only refers to an out-of-the-box build. Many non-default
options such as usemultiplicity tend to break binary compatibility
more often.
This is used by Configure et al to figure out
PERL_INC_VERSION_LIST, which lists version libraries
to include in @INC. See INSTALL for how this works.
*/
#define PERL_API_REVISION 5 /* Adjust manually as needed. */
#define PERL_API_VERSION 8 /* Adjust manually as needed. */
#define PERL_API_SUBVERSION 0 /* Adjust manually as needed. */
/*
XXX Note: The selection of non-default Configure options, such
as -Duselonglong may invalidate these settings. Currently, Configure
does not adequately test for this. A.D. Jan 13, 2000
*/
#define __PATCHLEVEL_H_INCLUDED__
#endif
/*
local_patches -- list of locally applied less-than-subversion patches.
If you're distributing such a patch, please give it a name and a
one-line description, placed just before the last NULL in the array
below. If your patch fixes a bug in the perlbug database, please
mention the bugid. If your patch *IS* dependent on a prior patch,
please place your applied patch line after its dependencies. This
will help tracking of patch dependencies.
Please either use 'diff --unified=0' if your diff supports
that or edit the hunk of the diff output which adds your patch
to this list, to remove context lines which would give patch
problems. For instance, if the original context diff is
*** patchlevel.h.orig <date here>
--- patchlevel.h <date here>
*** 38,43 ***
--- 38,44 ---
,"FOO1235 - some patch"
,"BAR3141 - another patch"
,"BAZ2718 - and another patch"
+ ,"MINE001 - my new patch"
,NULL
};
please change it to
*** patchlevel.h.orig <date here>
--- patchlevel.h <date here>
*** 41,43 ***
--- 41,44 ---
+ ,"MINE001 - my new patch"
,NULL
};
(Note changes to line numbers as well as removal of context lines.)
This will prevent patch from choking if someone has previously
applied different patches than you.
History has shown that nobody distributes patches that also
modify patchlevel.h. Do it yourself. The following perl
program can be used to add a comment to patchlevel.h:
#!perl
die "Usage: perl -x patchlevel.h comment ..." unless @ARGV;
open PLIN, "patchlevel.h" or die "Couldn't open patchlevel.h : $!";
open PLOUT, ">patchlevel.new" or die "Couldn't write on patchlevel.new : $!";
my $seen=0;
while (<PLIN>) {
if (/\t,NULL/ and $seen) {
while (my $c = shift @ARGV){
print PLOUT qq{\t,"$c"\n};
}
}
$seen++ if /local_patches\[\]/;
print PLOUT;
}
close PLOUT or die "Couldn't close filehandle writing to patchlevel.new : $!";
close PLIN or die "Couldn't close filehandle reading from patchlevel.h : $!";
close DATA; # needed to allow unlink to work win32.
unlink "patchlevel.bak" or warn "Couldn't unlink patchlevel.bak : $!"
if -e "patchlevel.bak";
rename "patchlevel.h", "patchlevel.bak" or
die "Couldn't rename patchlevel.h to patchlevel.bak : $!";
rename "patchlevel.new", "patchlevel.h" or
die "Couldn't rename patchlevel.new to patchlevel.h : $!";
__END__
Please keep empty lines below so that context diffs of this file do
not ever collect the lines belonging to local_patches() into the same
hunk.
*/
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static const char *local_patches[] = {
NULL
,NULL
};
/* Initial space prevents this variable from being inserted in config.sh */
# define LOCAL_PATCH_COUNT \
(sizeof(local_patches)/sizeof(local_patches[0])-2)
/* the old terms of reference, add them only when explicitly included */
#define PATCHLEVEL PERL_VERSION
#undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */
#define SUBVERSION PERL_SUBVERSION
#endif
--- NEW FILE: cop.h ---
/* cop.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
* and OP_SETSTATE that (loosely speaking) are separate statements.
* They hold information important for lexical state and error reporting.
* At run time, PL_curcop is set to point to the most recently executed cop,
* and thus can be used to determine our current state.
*/
struct cop {
BASEOP
char * cop_label; /* label for this construct */
#ifdef USE_ITHREADS
char * cop_stashpv; /* package line was compiled in */
char * cop_file; /* file name the following line # is from */
#else
HV * cop_stash; /* package line was compiled in */
GV * cop_filegv; /* file the following line # is from */
#endif
U32 cop_seq; /* parse sequence number */
I32 cop_arybase; /* array base this line was compiled with */
line_t cop_line; /* line # of this command */
SV * cop_warnings; /* lexical warnings bitmask */
SV * cop_io; /* lexical IO defaults */
};
#define Nullcop Null(COP*)
#ifdef USE_ITHREADS
# define CopFILE(c) ((c)->cop_file)
# define CopFILEGV(c) (CopFILE(c) \
? gv_fetchfile(CopFILE(c)) : Nullgv)
# ifdef NETWARE
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
# else
# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
# endif
# define CopFILESV(c) (CopFILE(c) \
? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
# define CopFILEAV(c) (CopFILE(c) \
? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
# define CopSTASHPV(c) ((c)->cop_stashpv)
# ifdef NETWARE
# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
# else
# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv))
# endif
# define CopSTASH(c) (CopSTASHPV(c) \
? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : Nullch)
# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
# define CopFILE_free(c) SAVECOPFILE_FREE(c)
# else
# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
# define CopSTASH(c) ((c)->cop_stash)
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : Nullch)
/* cop_stash is not refcounted */
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
# define CopSTASH_free(c)
# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = Nullgv))
#endif /* USE_ITHREADS */
#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
#define CopLINE(c) ((c)->cop_line)
#define CopLINE_inc(c) (++CopLINE(c))
#define CopLINE_dec(c) (--CopLINE(c))
#define CopLINE_set(c,l) (CopLINE(c) = (l))
/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
#ifdef MACOS_TRADITIONAL
# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
#else
# define OutCopFILE(c) CopFILE(c)
#endif
/*
* Here we have some enormously heavy (or at least ponderous) wizardry.
*/
/* subroutine context */
struct block_sub {
CV * cv;
GV * gv;
GV * dfoutgv;
#ifndef USE_5005THREADS
AV * savearray;
#endif /* USE_5005THREADS */
AV * argarray;
long olddepth;
U8 hasargs;
U8 lval; /* XXX merge lval and hasargs? */
PAD *oldcomppad;
};
/* base for the next two macros. Don't use directly.
* Note that the refcnt of the cv is incremented twice; The CX one is
* decremented by LEAVESUB, the other by LEAVE. */
#define PUSHSUB_BASE(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
cx->blk_sub.hasargs = hasargs; \
if (!CvDEPTH(cv)) { \
(void)SvREFCNT_inc(cv); \
(void)SvREFCNT_inc(cv); \
SAVEFREESV(cv); \
}
#define PUSHSUB(cx) \
PUSHSUB_BASE(cx) \
cx->blk_sub.lval = PL_op->op_private & \
(OPpLVAL_INTRO|OPpENTERSUB_INARGS);
/* variant for use by OP_DBSTATE, where op_private holds hint bits */
#define PUSHSUB_DB(cx) \
PUSHSUB_BASE(cx) \
cx->blk_sub.lval = 0;
#define PUSHFORMAT(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.gv = gv; \
cx->blk_sub.hasargs = 0; \
cx->blk_sub.dfoutgv = PL_defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
#ifdef USE_5005THREADS
# define POP_SAVEARRAY() NOOP
#else
# define POP_SAVEARRAY() \
STMT_START { \
SvREFCNT_dec(GvAV(PL_defgv)); \
GvAV(PL_defgv) = cx->blk_sub.savearray; \
} STMT_END
#endif /* USE_5005THREADS */
/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
* leave any (a fast av_clear(ary), basically) */
#define CLEAR_ARGARRAY(ary) \
STMT_START { \
AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
SvPV_set(ary, (char*)AvALLOC(ary)); \
AvFILLp(ary) = -1; \
} STMT_END
#define POPSUB(cx,sv) \
STMT_START { \
if (cx->blk_sub.hasargs) { \
POP_SAVEARRAY(); \
/* abandon @_ if it got reified */ \
if (AvREAL(cx->blk_sub.argarray)) { \
SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
SvREFCNT_dec(cx->blk_sub.argarray); \
cx->blk_sub.argarray = newAV(); \
av_extend(cx->blk_sub.argarray, fill); \
AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \
CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray; \
} \
else { \
CLEAR_ARGARRAY(cx->blk_sub.argarray); \
} \
} \
sv = (SV*)cx->blk_sub.cv; \
if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \
sv = Nullsv; \
} STMT_END
#define LEAVESUB(sv) \
STMT_START { \
if (sv) \
SvREFCNT_dec(sv); \
} STMT_END
#define POPFORMAT(cx) \
setdefout(cx->blk_sub.dfoutgv); \
SvREFCNT_dec(cx->blk_sub.dfoutgv);
/* eval context */
struct block_eval {
I32 old_in_eval;
I32 old_op_type;
SV * old_namesv;
OP * old_eval_root;
SV * cur_text;
CV * cv;
};
#define PUSHEVAL(cx,n,fgv) \
STMT_START { \
cx->blk_eval.old_in_eval = PL_in_eval; \
cx->blk_eval.old_op_type = PL_op->op_type; \
cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \
cx->blk_eval.old_eval_root = PL_eval_root; \
cx->blk_eval.cur_text = PL_linestr; \
cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \
} STMT_END
#define POPEVAL(cx) \
STMT_START { \
PL_in_eval = cx->blk_eval.old_in_eval; \
optype = cx->blk_eval.old_op_type; \
PL_eval_root = cx->blk_eval.old_eval_root; \
if (cx->blk_eval.old_namesv) \
sv_2mortal(cx->blk_eval.old_namesv); \
} STMT_END
/* loop context */
struct block_loop {
char * label;
I32 resetsp;
OP * redo_op;
OP * next_op;
OP * last_op;
#ifdef USE_ITHREADS
void * iterdata;
PAD *oldcomppad;
#else
SV ** itervar;
#endif
SV * itersave;
SV * iterlval;
AV * iterary;
IV iterix;
IV itermax;
};
#ifdef USE_ITHREADS
# define CxITERVAR(c) \
((c)->blk_loop.iterdata \
? (CxPADLOOP(cx) \
? &CX_CURPAD_SV( (c)->blk_loop, \
INT2PTR(PADOFFSET, (c)->blk_loop.iterdata)) \
: &GvSV((GV*)(c)->blk_loop.iterdata)) \
: (SV**)NULL)
# define CX_ITERDATA_SET(cx,idata) \
CX_CURPAD_SAVE(cx->blk_loop); \
if ((cx->blk_loop.iterdata = (idata))) \
cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
else \
cx->blk_loop.itersave = Nullsv;
#else
# define CxITERVAR(c) ((c)->blk_loop.itervar)
# define CX_ITERDATA_SET(cx,ivar) \
if ((cx->blk_loop.itervar = (SV**)(ivar))) \
cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
else \
cx->blk_loop.itersave = Nullsv;
#endif
#define PUSHLOOP(cx, dat, s) \
cx->blk_loop.label = PL_curcop->cop_label; \
cx->blk_loop.resetsp = s - PL_stack_base; \
cx->blk_loop.redo_op = cLOOP->op_redoop; \
cx->blk_loop.next_op = cLOOP->op_nextop; \
cx->blk_loop.last_op = cLOOP->op_lastop; \
cx->blk_loop.iterlval = Nullsv; \
cx->blk_loop.iterary = Nullav; \
cx->blk_loop.iterix = -1; \
CX_ITERDATA_SET(cx,dat);
#define POPLOOP(cx) \
SvREFCNT_dec(cx->blk_loop.iterlval); \
if (CxITERVAR(cx)) { \
SV **s_v_p = CxITERVAR(cx); \
sv_2mortal(*s_v_p); \
*s_v_p = cx->blk_loop.itersave; \
} \
if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
SvREFCNT_dec(cx->blk_loop.iterary);
/* context common to subroutines, evals and loops */
struct block {
I32 blku_oldsp; /* stack pointer to copy stuff down to */
COP * blku_oldcop; /* old curcop pointer */
I32 blku_oldretsp; /* return stack index */
I32 blku_oldmarksp; /* mark stack index */
I32 blku_oldscopesp; /* scope stack index */
PMOP * blku_oldpm; /* values of pattern match vars */
U8 blku_gimme; /* is this block running in list context? */
union {
struct block_sub blku_sub;
struct block_eval blku_eval;
struct block_loop blku_loop;
} blk_u;
};
#define blk_oldsp cx_u.cx_blk.blku_oldsp
#define blk_oldcop cx_u.cx_blk.blku_oldcop
#define blk_oldretsp cx_u.cx_blk.blku_oldretsp
#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
#define blk_oldpm cx_u.cx_blk.blku_oldpm
#define blk_gimme cx_u.cx_blk.blku_gimme
#define blk_sub cx_u.cx_blk.blk_u.blku_sub
#define blk_eval cx_u.cx_blk.blk_u.blku_eval
#define blk_loop cx_u.cx_blk.blk_u.blku_loop
/* Enter a block. */
#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
cx->cx_type = t, \
cx->blk_oldsp = sp - PL_stack_base, \
cx->blk_oldcop = PL_curcop, \
cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
cx->blk_oldscopesp = PL_scopestack_ix, \
cx->blk_oldretsp = PL_retstack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = (U8)gimme; \
DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
(long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
/* Exit a block (RETURN and LAST). */
#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
newsp = PL_stack_base + cx->blk_oldsp, \
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
PL_retstack_ix = cx->blk_oldretsp, \
pm = cx->blk_oldpm, \
gimme = cx->blk_gimme; \
DEBUG_SCOPE("POPBLOCK"); \
DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \
(long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
/* Continue a block elsewhere (NEXT and REDO). */
#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
PL_retstack_ix = cx->blk_oldretsp, \
PL_curpm = cx->blk_oldpm; \
DEBUG_SCOPE("TOPBLOCK");
/* substitution context */
struct subst {
I32 sbu_iters;
I32 sbu_maxiters;
I32 sbu_rflags;
I32 sbu_oldsave;
bool sbu_once;
bool sbu_rxtainted;
char * sbu_orig;
SV * sbu_dstr;
SV * sbu_targ;
char * sbu_s;
char * sbu_m;
char * sbu_strend;
void * sbu_rxres;
REGEXP * sbu_rx;
};
#define sb_iters cx_u.cx_subst.sbu_iters
#define sb_maxiters cx_u.cx_subst.sbu_maxiters
#define sb_rflags cx_u.cx_subst.sbu_rflags
#define sb_oldsave cx_u.cx_subst.sbu_oldsave
#define sb_once cx_u.cx_subst.sbu_once
#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
#define sb_orig cx_u.cx_subst.sbu_orig
#define sb_dstr cx_u.cx_subst.sbu_dstr
#define sb_targ cx_u.cx_subst.sbu_targ
#define sb_s cx_u.cx_subst.sbu_s
#define sb_m cx_u.cx_subst.sbu_m
#define sb_strend cx_u.cx_subst.sbu_strend
#define sb_rxres cx_u.cx_subst.sbu_rxres
#define sb_rx cx_u.cx_subst.sbu_rx
#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
cx->sb_iters = iters, \
cx->sb_maxiters = maxiters, \
cx->sb_rflags = r_flags, \
cx->sb_oldsave = oldsave, \
cx->sb_once = once, \
cx->sb_rxtainted = rxtainted, \
cx->sb_orig = orig, \
cx->sb_dstr = dstr, \
cx->sb_targ = targ, \
cx->sb_s = s, \
cx->sb_m = m, \
cx->sb_strend = strend, \
cx->sb_rxres = Null(void*), \
cx->sb_rx = rx, \
cx->cx_type = CXt_SUBST; \
rxres_save(&cx->sb_rxres, rx)
#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
rxres_free(&cx->sb_rxres)
struct context {
U32 cx_type; /* what kind of context this is */
union {
struct block cx_blk;
struct subst cx_subst;
} cx_u;
};
#define CXTYPEMASK 0xff
#define CXt_NULL 0
#define CXt_SUB 1
#define CXt_EVAL 2
#define CXt_LOOP 3
#define CXt_SUBST 4
#define CXt_BLOCK 5
#define CXt_FORMAT 6
/* private flags for CXt_EVAL */
#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
#define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */
#ifdef USE_ITHREADS
/* private flags for CXt_LOOP */
# define CXp_PADVAR 0x00000100 /* itervar lives on pad, iterdata
has pad offset; if not set,
iterdata holds GV* */
# define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP|CXp_PADVAR)) \
== (CXt_LOOP|CXp_PADVAR))
#endif
#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \
== (CXt_EVAL|CXp_REAL))
#define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK)) \
== (CXt_EVAL|CXp_TRYBLOCK))
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
/*
=head1 "Gimme" Values
*/
/*
=for apidoc AmU||G_SCALAR
Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and
L<perlcall>.
=for apidoc AmU||G_ARRAY
Used to indicate list context. See C<GIMME_V>, C<GIMME> and
L<perlcall>.
=for apidoc AmU||G_VOID
Used to indicate void context. See C<GIMME_V> and L<perlcall>.
=for apidoc AmU||G_DISCARD
Indicates that arguments returned from a callback should be discarded. See
L<perlcall>.
=for apidoc AmU||G_EVAL
Used to force a Perl C<eval> wrapper around a callback. See
L<perlcall>.
=for apidoc AmU||G_NOARGS
Indicates that no arguments are being sent to a callback. See
L<perlcall>.
=cut
*/
#define G_SCALAR 0
#define G_ARRAY 1
#define G_VOID 128 /* skip this bit when adding flags below */
/* extra flags for Perl_call_* routines */
#define G_DISCARD 2 /* Call FREETMPS. */
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#define G_NOARGS 8 /* Don't construct a @_ array. */
#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
#define G_NODEBUG 32 /* Disable debugging at toplevel. */
#define G_METHOD 64 /* Calling method. */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
#define EVAL_INEVAL 1 /* some enclosing scope is an eval */
#define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
#define EVAL_INREQUIRE 8 /* The code is being required. */
/* Support for switching (stack and block) contexts.
* This ensures magic doesn't invalidate local stack and cx pointers.
*/
#define PERLSI_UNKNOWN -1
#define PERLSI_UNDEF 0
#define PERLSI_MAIN 1
#define PERLSI_MAGIC 2
#define PERLSI_SORT 3
#define PERLSI_SIGNAL 4
#define PERLSI_OVERLOAD 5
#define PERLSI_DESTROY 6
#define PERLSI_WARNHOOK 7
#define PERLSI_DIEHOOK 8
#define PERLSI_REQUIRE 9
struct stackinfo {
AV * si_stack; /* stack for current runlevel */
PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
I32 si_cxix; /* current context index */
I32 si_cxmax; /* maximum allocated index */
I32 si_type; /* type of runlevel */
struct stackinfo * si_prev;
struct stackinfo * si_next;
I32 si_markoff; /* offset where markstack begins for us.
* currently used only with DEBUGGING,
* but not #ifdef-ed for bincompat */
};
typedef struct stackinfo PERL_SI;
#define cxstack (PL_curstackinfo->si_cxstack)
#define cxstack_ix (PL_curstackinfo->si_cxix)
#define cxstack_max (PL_curstackinfo->si_cxmax)
#ifdef DEBUGGING
# define SET_MARK_OFFSET \
PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
#else
# define SET_MARK_OFFSET NOOP
#endif
#define PUSHSTACKi(type) \
STMT_START { \
PERL_SI *next = PL_curstackinfo->si_next; \
if (!next) { \
next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
next->si_prev = PL_curstackinfo; \
PL_curstackinfo->si_next = next; \
} \
next->si_type = type; \
next->si_cxix = -1; \
AvFILLp(next->si_stack) = 0; \
SWITCHSTACK(PL_curstack,next->si_stack); \
PL_curstackinfo = next; \
SET_MARK_OFFSET; \
} STMT_END
#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
* PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
#define POPSTACK \
STMT_START { \
dSP; \
PERL_SI *prev = PL_curstackinfo->si_prev; \
if (!prev) { \
PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
my_exit(1); \
} \
SWITCHSTACK(PL_curstack,prev->si_stack); \
/* don't free prev here, free them all at the END{} */ \
PL_curstackinfo = prev; \
} STMT_END
#define POPSTACK_TO(s) \
STMT_START { \
while (PL_curstack != s) { \
dounwind(-1); \
POPSTACK; \
} \
} STMT_END
#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
--- NEW FILE: pp_proto.h ---
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by opcode.pl from its data. Any changes made here
will be lost!
*/
PERL_CKDEF(Perl_ck_anoncode)
PERL_CKDEF(Perl_ck_bitop)
PERL_CKDEF(Perl_ck_concat)
PERL_CKDEF(Perl_ck_defined)
PERL_CKDEF(Perl_ck_delete)
PERL_CKDEF(Perl_ck_die)
PERL_CKDEF(Perl_ck_eof)
PERL_CKDEF(Perl_ck_eval)
PERL_CKDEF(Perl_ck_exec)
PERL_CKDEF(Perl_ck_exists)
PERL_CKDEF(Perl_ck_exit)
PERL_CKDEF(Perl_ck_ftst)
PERL_CKDEF(Perl_ck_fun)
PERL_CKDEF(Perl_ck_glob)
PERL_CKDEF(Perl_ck_grep)
PERL_CKDEF(Perl_ck_index)
PERL_CKDEF(Perl_ck_join)
PERL_CKDEF(Perl_ck_lengthconst)
PERL_CKDEF(Perl_ck_lfun)
PERL_CKDEF(Perl_ck_listiob)
PERL_CKDEF(Perl_ck_match)
PERL_CKDEF(Perl_ck_method)
PERL_CKDEF(Perl_ck_null)
PERL_CKDEF(Perl_ck_open)
PERL_CKDEF(Perl_ck_repeat)
PERL_CKDEF(Perl_ck_require)
PERL_CKDEF(Perl_ck_return)
PERL_CKDEF(Perl_ck_rfun)
PERL_CKDEF(Perl_ck_rvconst)
PERL_CKDEF(Perl_ck_sassign)
PERL_CKDEF(Perl_ck_select)
PERL_CKDEF(Perl_ck_shift)
PERL_CKDEF(Perl_ck_sort)
PERL_CKDEF(Perl_ck_spair)
PERL_CKDEF(Perl_ck_split)
PERL_CKDEF(Perl_ck_subr)
PERL_CKDEF(Perl_ck_substr)
PERL_CKDEF(Perl_ck_svconst)
PERL_CKDEF(Perl_ck_trunc)
PERL_PPDEF(Perl_pp_null)
PERL_PPDEF(Perl_pp_stub)
PERL_PPDEF(Perl_pp_scalar)
PERL_PPDEF(Perl_pp_pushmark)
PERL_PPDEF(Perl_pp_wantarray)
PERL_PPDEF(Perl_pp_const)
PERL_PPDEF(Perl_pp_gvsv)
PERL_PPDEF(Perl_pp_gv)
PERL_PPDEF(Perl_pp_gelem)
PERL_PPDEF(Perl_pp_padsv)
PERL_PPDEF(Perl_pp_padav)
PERL_PPDEF(Perl_pp_padhv)
PERL_PPDEF(Perl_pp_padany)
PERL_PPDEF(Perl_pp_pushre)
PERL_PPDEF(Perl_pp_rv2gv)
PERL_PPDEF(Perl_pp_rv2sv)
PERL_PPDEF(Perl_pp_av2arylen)
PERL_PPDEF(Perl_pp_rv2cv)
PERL_PPDEF(Perl_pp_anoncode)
PERL_PPDEF(Perl_pp_prototype)
PERL_PPDEF(Perl_pp_refgen)
PERL_PPDEF(Perl_pp_srefgen)
PERL_PPDEF(Perl_pp_ref)
PERL_PPDEF(Perl_pp_bless)
PERL_PPDEF(Perl_pp_backtick)
PERL_PPDEF(Perl_pp_glob)
PERL_PPDEF(Perl_pp_readline)
PERL_PPDEF(Perl_pp_rcatline)
PERL_PPDEF(Perl_pp_regcmaybe)
PERL_PPDEF(Perl_pp_regcreset)
PERL_PPDEF(Perl_pp_regcomp)
PERL_PPDEF(Perl_pp_match)
PERL_PPDEF(Perl_pp_qr)
PERL_PPDEF(Perl_pp_subst)
PERL_PPDEF(Perl_pp_substcont)
PERL_PPDEF(Perl_pp_trans)
PERL_PPDEF(Perl_pp_sassign)
PERL_PPDEF(Perl_pp_aassign)
PERL_PPDEF(Perl_pp_chop)
PERL_PPDEF(Perl_pp_schop)
PERL_PPDEF(Perl_pp_chomp)
PERL_PPDEF(Perl_pp_schomp)
PERL_PPDEF(Perl_pp_defined)
PERL_PPDEF(Perl_pp_undef)
PERL_PPDEF(Perl_pp_study)
PERL_PPDEF(Perl_pp_pos)
PERL_PPDEF(Perl_pp_preinc)
PERL_PPDEF(Perl_pp_predec)
PERL_PPDEF(Perl_pp_postinc)
PERL_PPDEF(Perl_pp_postdec)
PERL_PPDEF(Perl_pp_pow)
PERL_PPDEF(Perl_pp_multiply)
PERL_PPDEF(Perl_pp_i_multiply)
PERL_PPDEF(Perl_pp_divide)
PERL_PPDEF(Perl_pp_i_divide)
PERL_PPDEF(Perl_pp_modulo)
PERL_PPDEF(Perl_pp_i_modulo)
PERL_PPDEF(Perl_pp_repeat)
PERL_PPDEF(Perl_pp_add)
PERL_PPDEF(Perl_pp_i_add)
PERL_PPDEF(Perl_pp_subtract)
PERL_PPDEF(Perl_pp_i_subtract)
PERL_PPDEF(Perl_pp_concat)
PERL_PPDEF(Perl_pp_stringify)
PERL_PPDEF(Perl_pp_left_shift)
PERL_PPDEF(Perl_pp_right_shift)
PERL_PPDEF(Perl_pp_lt)
PERL_PPDEF(Perl_pp_i_lt)
PERL_PPDEF(Perl_pp_gt)
PERL_PPDEF(Perl_pp_i_gt)
PERL_PPDEF(Perl_pp_le)
PERL_PPDEF(Perl_pp_i_le)
PERL_PPDEF(Perl_pp_ge)
PERL_PPDEF(Perl_pp_i_ge)
PERL_PPDEF(Perl_pp_eq)
PERL_PPDEF(Perl_pp_i_eq)
PERL_PPDEF(Perl_pp_ne)
PERL_PPDEF(Perl_pp_i_ne)
PERL_PPDEF(Perl_pp_ncmp)
PERL_PPDEF(Perl_pp_i_ncmp)
PERL_PPDEF(Perl_pp_slt)
PERL_PPDEF(Perl_pp_sgt)
PERL_PPDEF(Perl_pp_sle)
PERL_PPDEF(Perl_pp_sge)
PERL_PPDEF(Perl_pp_seq)
PERL_PPDEF(Perl_pp_sne)
PERL_PPDEF(Perl_pp_scmp)
PERL_PPDEF(Perl_pp_bit_and)
PERL_PPDEF(Perl_pp_bit_xor)
PERL_PPDEF(Perl_pp_bit_or)
PERL_PPDEF(Perl_pp_negate)
PERL_PPDEF(Perl_pp_i_negate)
PERL_PPDEF(Perl_pp_not)
PERL_PPDEF(Perl_pp_complement)
PERL_PPDEF(Perl_pp_atan2)
PERL_PPDEF(Perl_pp_sin)
PERL_PPDEF(Perl_pp_cos)
PERL_PPDEF(Perl_pp_rand)
PERL_PPDEF(Perl_pp_srand)
PERL_PPDEF(Perl_pp_exp)
PERL_PPDEF(Perl_pp_log)
PERL_PPDEF(Perl_pp_sqrt)
PERL_PPDEF(Perl_pp_int)
PERL_PPDEF(Perl_pp_hex)
PERL_PPDEF(Perl_pp_oct)
PERL_PPDEF(Perl_pp_abs)
PERL_PPDEF(Perl_pp_length)
PERL_PPDEF(Perl_pp_substr)
PERL_PPDEF(Perl_pp_vec)
PERL_PPDEF(Perl_pp_index)
PERL_PPDEF(Perl_pp_rindex)
PERL_PPDEF(Perl_pp_sprintf)
PERL_PPDEF(Perl_pp_formline)
PERL_PPDEF(Perl_pp_ord)
PERL_PPDEF(Perl_pp_chr)
PERL_PPDEF(Perl_pp_crypt)
PERL_PPDEF(Perl_pp_ucfirst)
PERL_PPDEF(Perl_pp_lcfirst)
PERL_PPDEF(Perl_pp_uc)
PERL_PPDEF(Perl_pp_lc)
PERL_PPDEF(Perl_pp_quotemeta)
PERL_PPDEF(Perl_pp_rv2av)
PERL_PPDEF(Perl_pp_aelemfast)
PERL_PPDEF(Perl_pp_aelem)
PERL_PPDEF(Perl_pp_aslice)
PERL_PPDEF(Perl_pp_each)
PERL_PPDEF(Perl_pp_values)
PERL_PPDEF(Perl_pp_keys)
PERL_PPDEF(Perl_pp_delete)
PERL_PPDEF(Perl_pp_exists)
PERL_PPDEF(Perl_pp_rv2hv)
PERL_PPDEF(Perl_pp_helem)
PERL_PPDEF(Perl_pp_hslice)
PERL_PPDEF(Perl_pp_unpack)
PERL_PPDEF(Perl_pp_pack)
PERL_PPDEF(Perl_pp_split)
PERL_PPDEF(Perl_pp_join)
PERL_PPDEF(Perl_pp_list)
PERL_PPDEF(Perl_pp_lslice)
PERL_PPDEF(Perl_pp_anonlist)
PERL_PPDEF(Perl_pp_anonhash)
PERL_PPDEF(Perl_pp_splice)
PERL_PPDEF(Perl_pp_push)
PERL_PPDEF(Perl_pp_pop)
PERL_PPDEF(Perl_pp_shift)
PERL_PPDEF(Perl_pp_unshift)
PERL_PPDEF(Perl_pp_sort)
PERL_PPDEF(Perl_pp_reverse)
PERL_PPDEF(Perl_pp_grepstart)
PERL_PPDEF(Perl_pp_grepwhile)
PERL_PPDEF(Perl_pp_mapstart)
PERL_PPDEF(Perl_pp_mapwhile)
PERL_PPDEF(Perl_pp_range)
PERL_PPDEF(Perl_pp_flip)
PERL_PPDEF(Perl_pp_flop)
PERL_PPDEF(Perl_pp_and)
PERL_PPDEF(Perl_pp_or)
PERL_PPDEF(Perl_pp_xor)
PERL_PPDEF(Perl_pp_cond_expr)
PERL_PPDEF(Perl_pp_andassign)
PERL_PPDEF(Perl_pp_orassign)
PERL_PPDEF(Perl_pp_method)
PERL_PPDEF(Perl_pp_entersub)
PERL_PPDEF(Perl_pp_leavesub)
PERL_PPDEF(Perl_pp_leavesublv)
PERL_PPDEF(Perl_pp_caller)
PERL_PPDEF(Perl_pp_warn)
PERL_PPDEF(Perl_pp_die)
PERL_PPDEF(Perl_pp_reset)
PERL_PPDEF(Perl_pp_lineseq)
PERL_PPDEF(Perl_pp_nextstate)
PERL_PPDEF(Perl_pp_dbstate)
PERL_PPDEF(Perl_pp_unstack)
PERL_PPDEF(Perl_pp_enter)
PERL_PPDEF(Perl_pp_leave)
PERL_PPDEF(Perl_pp_scope)
PERL_PPDEF(Perl_pp_enteriter)
PERL_PPDEF(Perl_pp_iter)
PERL_PPDEF(Perl_pp_enterloop)
PERL_PPDEF(Perl_pp_leaveloop)
PERL_PPDEF(Perl_pp_return)
PERL_PPDEF(Perl_pp_last)
PERL_PPDEF(Perl_pp_next)
PERL_PPDEF(Perl_pp_redo)
PERL_PPDEF(Perl_pp_dump)
PERL_PPDEF(Perl_pp_goto)
PERL_PPDEF(Perl_pp_exit)
PERL_PPDEF(Perl_pp_open)
PERL_PPDEF(Perl_pp_close)
PERL_PPDEF(Perl_pp_pipe_op)
PERL_PPDEF(Perl_pp_fileno)
PERL_PPDEF(Perl_pp_umask)
PERL_PPDEF(Perl_pp_binmode)
PERL_PPDEF(Perl_pp_tie)
PERL_PPDEF(Perl_pp_untie)
PERL_PPDEF(Perl_pp_tied)
PERL_PPDEF(Perl_pp_dbmopen)
PERL_PPDEF(Perl_pp_dbmclose)
PERL_PPDEF(Perl_pp_sselect)
PERL_PPDEF(Perl_pp_select)
PERL_PPDEF(Perl_pp_getc)
PERL_PPDEF(Perl_pp_read)
PERL_PPDEF(Perl_pp_enterwrite)
PERL_PPDEF(Perl_pp_leavewrite)
PERL_PPDEF(Perl_pp_prtf)
PERL_PPDEF(Perl_pp_print)
PERL_PPDEF(Perl_pp_sysopen)
PERL_PPDEF(Perl_pp_sysseek)
PERL_PPDEF(Perl_pp_sysread)
PERL_PPDEF(Perl_pp_syswrite)
PERL_PPDEF(Perl_pp_send)
PERL_PPDEF(Perl_pp_recv)
PERL_PPDEF(Perl_pp_eof)
PERL_PPDEF(Perl_pp_tell)
PERL_PPDEF(Perl_pp_seek)
PERL_PPDEF(Perl_pp_truncate)
PERL_PPDEF(Perl_pp_fcntl)
PERL_PPDEF(Perl_pp_ioctl)
PERL_PPDEF(Perl_pp_flock)
PERL_PPDEF(Perl_pp_socket)
PERL_PPDEF(Perl_pp_sockpair)
PERL_PPDEF(Perl_pp_bind)
PERL_PPDEF(Perl_pp_connect)
PERL_PPDEF(Perl_pp_listen)
PERL_PPDEF(Perl_pp_accept)
PERL_PPDEF(Perl_pp_shutdown)
PERL_PPDEF(Perl_pp_gsockopt)
PERL_PPDEF(Perl_pp_ssockopt)
PERL_PPDEF(Perl_pp_getsockname)
PERL_PPDEF(Perl_pp_getpeername)
PERL_PPDEF(Perl_pp_lstat)
PERL_PPDEF(Perl_pp_stat)
PERL_PPDEF(Perl_pp_ftrread)
PERL_PPDEF(Perl_pp_ftrwrite)
PERL_PPDEF(Perl_pp_ftrexec)
PERL_PPDEF(Perl_pp_fteread)
PERL_PPDEF(Perl_pp_ftewrite)
PERL_PPDEF(Perl_pp_fteexec)
PERL_PPDEF(Perl_pp_ftis)
PERL_PPDEF(Perl_pp_fteowned)
PERL_PPDEF(Perl_pp_ftrowned)
PERL_PPDEF(Perl_pp_ftzero)
PERL_PPDEF(Perl_pp_ftsize)
PERL_PPDEF(Perl_pp_ftmtime)
PERL_PPDEF(Perl_pp_ftatime)
PERL_PPDEF(Perl_pp_ftctime)
PERL_PPDEF(Perl_pp_ftsock)
PERL_PPDEF(Perl_pp_ftchr)
PERL_PPDEF(Perl_pp_ftblk)
PERL_PPDEF(Perl_pp_ftfile)
PERL_PPDEF(Perl_pp_ftdir)
PERL_PPDEF(Perl_pp_ftpipe)
PERL_PPDEF(Perl_pp_ftlink)
PERL_PPDEF(Perl_pp_ftsuid)
PERL_PPDEF(Perl_pp_ftsgid)
PERL_PPDEF(Perl_pp_ftsvtx)
PERL_PPDEF(Perl_pp_fttty)
PERL_PPDEF(Perl_pp_fttext)
PERL_PPDEF(Perl_pp_ftbinary)
PERL_PPDEF(Perl_pp_chdir)
PERL_PPDEF(Perl_pp_chown)
PERL_PPDEF(Perl_pp_chroot)
PERL_PPDEF(Perl_pp_unlink)
PERL_PPDEF(Perl_pp_chmod)
PERL_PPDEF(Perl_pp_utime)
PERL_PPDEF(Perl_pp_rename)
PERL_PPDEF(Perl_pp_link)
PERL_PPDEF(Perl_pp_symlink)
PERL_PPDEF(Perl_pp_readlink)
PERL_PPDEF(Perl_pp_mkdir)
PERL_PPDEF(Perl_pp_rmdir)
PERL_PPDEF(Perl_pp_open_dir)
PERL_PPDEF(Perl_pp_readdir)
PERL_PPDEF(Perl_pp_telldir)
PERL_PPDEF(Perl_pp_seekdir)
PERL_PPDEF(Perl_pp_rewinddir)
PERL_PPDEF(Perl_pp_closedir)
PERL_PPDEF(Perl_pp_fork)
PERL_PPDEF(Perl_pp_wait)
PERL_PPDEF(Perl_pp_waitpid)
PERL_PPDEF(Perl_pp_system)
PERL_PPDEF(Perl_pp_exec)
PERL_PPDEF(Perl_pp_kill)
PERL_PPDEF(Perl_pp_getppid)
PERL_PPDEF(Perl_pp_getpgrp)
PERL_PPDEF(Perl_pp_setpgrp)
PERL_PPDEF(Perl_pp_getpriority)
PERL_PPDEF(Perl_pp_setpriority)
PERL_PPDEF(Perl_pp_time)
PERL_PPDEF(Perl_pp_tms)
PERL_PPDEF(Perl_pp_localtime)
PERL_PPDEF(Perl_pp_gmtime)
PERL_PPDEF(Perl_pp_alarm)
PERL_PPDEF(Perl_pp_sleep)
PERL_PPDEF(Perl_pp_shmget)
PERL_PPDEF(Perl_pp_shmctl)
PERL_PPDEF(Perl_pp_shmread)
PERL_PPDEF(Perl_pp_shmwrite)
PERL_PPDEF(Perl_pp_msgget)
PERL_PPDEF(Perl_pp_msgctl)
PERL_PPDEF(Perl_pp_msgsnd)
PERL_PPDEF(Perl_pp_msgrcv)
PERL_PPDEF(Perl_pp_semget)
PERL_PPDEF(Perl_pp_semctl)
PERL_PPDEF(Perl_pp_semop)
PERL_PPDEF(Perl_pp_require)
PERL_PPDEF(Perl_pp_dofile)
PERL_PPDEF(Perl_pp_entereval)
PERL_PPDEF(Perl_pp_leaveeval)
PERL_PPDEF(Perl_pp_entertry)
PERL_PPDEF(Perl_pp_leavetry)
PERL_PPDEF(Perl_pp_ghbyname)
PERL_PPDEF(Perl_pp_ghbyaddr)
PERL_PPDEF(Perl_pp_ghostent)
PERL_PPDEF(Perl_pp_gnbyname)
PERL_PPDEF(Perl_pp_gnbyaddr)
PERL_PPDEF(Perl_pp_gnetent)
PERL_PPDEF(Perl_pp_gpbyname)
PERL_PPDEF(Perl_pp_gpbynumber)
PERL_PPDEF(Perl_pp_gprotoent)
PERL_PPDEF(Perl_pp_gsbyname)
PERL_PPDEF(Perl_pp_gsbyport)
PERL_PPDEF(Perl_pp_gservent)
PERL_PPDEF(Perl_pp_shostent)
PERL_PPDEF(Perl_pp_snetent)
PERL_PPDEF(Perl_pp_sprotoent)
PERL_PPDEF(Perl_pp_sservent)
PERL_PPDEF(Perl_pp_ehostent)
PERL_PPDEF(Perl_pp_enetent)
PERL_PPDEF(Perl_pp_eprotoent)
PERL_PPDEF(Perl_pp_eservent)
PERL_PPDEF(Perl_pp_gpwnam)
PERL_PPDEF(Perl_pp_gpwuid)
PERL_PPDEF(Perl_pp_gpwent)
PERL_PPDEF(Perl_pp_spwent)
PERL_PPDEF(Perl_pp_epwent)
PERL_PPDEF(Perl_pp_ggrnam)
PERL_PPDEF(Perl_pp_ggrgid)
PERL_PPDEF(Perl_pp_ggrent)
PERL_PPDEF(Perl_pp_sgrent)
PERL_PPDEF(Perl_pp_egrent)
PERL_PPDEF(Perl_pp_getlogin)
PERL_PPDEF(Perl_pp_syscall)
PERL_PPDEF(Perl_pp_lock)
PERL_PPDEF(Perl_pp_threadsv)
PERL_PPDEF(Perl_pp_setstate)
PERL_PPDEF(Perl_pp_method_named)
/* ex: set ro: */
--- NEW FILE: pp_pack.c ---
/* pp_pack.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* He still hopefully carried some of his gear in his pack: a small tinder-box,
* two small shallow pans, the smaller fitting into the larger; inside them a
* wooden spoon, a short two-pronged fork and some skewers were stowed; and
* hidden at the bottom of the pack in a flat wooden box a dwindling treasure,
* some salt.
*/
/* This file contains pp ("push/pop") functions that
[...2740 lines suppressed...]
MARK++;
sv_setpvn(cat, "", 0);
packlist(cat, (char *) pat, (char *) patend, MARK, SP + 1);
SvSETMAGIC(cat);
SP = ORIGMARK;
PUSHs(cat);
RETURN;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.plan9 ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
perlplan9 - Plan 9-specific documentation for Perl
=head1 DESCRIPTION
These are a few notes describing features peculiar to
Plan 9 Perl. As such, it is not intended to be a replacement
for the rest of the Perl 5 documentation (which is both
copious and excellent). If you have any questions to
which you can't find answers in these man pages, contact
Luther Huffman at lutherh at stratcom.com and we'll try to
answer them.
=head2 Invoking Perl
Perl is invoked from the command line as described in
L<perl>. Most perl scripts, however, do have a first line
such as "#!/usr/local/bin/perl". This is known as a shebang
(shell-bang) statement and tells the OS shell where to find
the perl interpreter. In Plan 9 Perl this statement should be
"#!/bin/perl" if you wish to be able to directly invoke the
script by its name.
Alternatively, you may invoke perl with the command "Perl"
instead of "perl". This will produce Acme-friendly error
messages of the form "filename:18".
Some scripts, usually identified with a *.PL extension, are
self-configuring and are able to correctly create their own
shebang path from config information located in Plan 9
Perl. These you won't need to be worried about.
=head2 What's in Plan 9 Perl
Although Plan 9 Perl currently only provides static
loading, it is built with a number of useful extensions.
These include Opcode, FileHandle, Fcntl, and POSIX. Expect
to see others (and DynaLoading!) in the future.
=head2 What's not in Plan 9 Perl
As mentioned previously, dynamic loading isn't currently
available nor is MakeMaker. Both are high-priority items.
=head2 Perl5 Functions not currently supported in Plan 9 Perl
Some, such as C<chown> and C<umask> aren't provided
because the concept does not exist within Plan 9. Others,
such as some of the socket-related functions, simply
haven't been written yet. Many in the latter category
may be supported in the future.
The functions not currently implemented include:
chown, chroot, dbmclose, dbmopen, getsockopt,
setsockopt, recvmsg, sendmsg, getnetbyname,
getnetbyaddr, getnetent, getprotoent, getservent,
sethostent, setnetent, setprotoent, setservent,
endservent, endnetent, endprotoent, umask
There may be several other functions that have undefined
behavior so this list shouldn't be considered complete.
=head2 Signals in Plan 9 Perl
For compatibility with perl scripts written for the Unix
environment, Plan 9 Perl uses the POSIX signal emulation
provided in Plan 9's ANSI POSIX Environment (APE). Signal stacking
isn't supported. The signals provided are:
SIGHUP, SIGINT, SIGQUIT, SIGILL, SIGABRT,
SIGFPE, SIGKILL, SIGSEGV, SIGPIPE, SIGPIPE, SIGALRM,
SIGTERM, SIGUSR1, SIGUSR2, SIGCHLD, SIGCONT,
SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU
=head1 COMPILING AND INSTALLING PERL ON PLAN 9
WELCOME to Plan 9 Perl, brave soul!
This is a preliminary alpha version of Plan 9 Perl. Still to be
implemented are MakeMaker and DynaLoader. Many perl commands are
missing or currently behave in an inscrutable manner. These gaps will,
with perseverance and a modicum of luck, be remedied in the near
future.To install this software:
1. Create the source directories and libraries for perl by running the
plan9/setup.rc command (i.e., located in the plan9 subdirectory).
Note: the setup routine assumes that you haven't dearchived these
files into /sys/src/cmd/perl. After running setup.rc you may delete
the copy of the source you originally detarred, as source code has now
been installed in /sys/src/cmd/perl. If you plan on installing perl
binaries for all architectures, run "setup.rc -a".
2. After making sure that you have adequate privileges to build system
software, from /sys/src/cmd/perl/5.00301 (adjust version
appropriately) run:
mk install
If you wish to install perl versions for all architectures (68020,
mips, sparc and 386) run:
mk installall
3. Wait. The build process will take a *long* time because perl
bootstraps itself. A 75MHz Pentium, 16MB RAM machine takes roughly 30
minutes to build the distribution from scratch.
=head2 Installing Perl Documentation on Plan 9
This perl distribution comes with a tremendous amount of
documentation. To add these to the built-in manuals that come with
Plan 9, from /sys/src/cmd/perl/5.00301 (adjust version appropriately)
run:
mk man
To begin your reading, start with:
man perl
This is a good introduction and will direct you towards other man
pages that may interest you.
(Note: "mk man" may produce some extraneous noise. Fear not.)
=head1 BUGS
"As many as there are grains of sand on all the beaches of the
world . . ." - Carl Sagan
=head1 Revision date
This document was revised 09-October-1996 for Perl 5.003_7.
=head1 AUTHOR
Direct questions, comments, and the unlikely bug report (ahem) direct
comments toward:
Luther Huffman, lutherh at stratcom.com,
Strategic Computer Solutions, Inc.
--- NEW FILE: pp_sys.c ---
/* pp_sys.c
*
* Copyright (C) 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* But only a short way ahead its floor and the walls on either side were
* cloven by a great fissure, out of which the red glare came, now leaping
* up, now dying down into darkness; and all the while far below there was
* a rumour and a trouble as of great engines throbbing and labouring.
*/
/* This file contains system pp ("push/pop") functions that
* execute the opcodes that make up a perl program. A typical pp function
[...5808 lines suppressed...]
break;
}
if (pos > 0) /* need to restore position of the handle */
PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */
return (i);
}
#endif /* LOCKF_EMULATE_FLOCK */
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.apollo ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.apollo - Perl version 5 on Apollo DomainOS
=head1 DESCRIPTION
The following tests are known to fail as of Perl 5.005_03:
comp/decl..........FAILED at test 0
op/write...........FAILED at test 0
lib/filefind.......FAILED at test 2
lib/io_udp.........FAILED at test 2
lib/findbin........stat(/ressel/ABT/USER/vta/jk/proj.local/perl/perl5.005_03-MAINT_TRIAL_5/t/lib/): No such file or directory at ../lib/FindBin.pm line 162
stat(/ressel/ABT/USER/vta/jk/proj.local/perl/perl5.005_03-MAINT_TRIAL_5/t/lib/): No such file or directory at ../lib/FindBin.pm line 163
FAILED at test 1
=head1 AUTHOR
Johann Klasek <jk at auto.tuwien.ac.at>
--- NEW FILE: installhtml ---
#!./perl -Ilib -w
# This file should really be extracted from a .PL file
use strict;
use Config; # for config options in the makefile
use File::Spec;
use Getopt::Long; # for command-line parsing
use Cwd;
use Pod::Html 'anchorify';
=head1 NAME
installhtml - converts a collection of POD pages to HTML format.
=head1 SYNOPSIS
installhtml [--help] [--podpath=<name>:...:<name>] [--podroot=<name>]
[--htmldir=<name>] [--htmlroot=<name>] [--norecurse] [--recurse]
[--splithead=<name>,...,<name>] [--splititem=<name>,...,<name>]
[--libpods=<name>,...,<name>] [--ignore=<name>,...,<name>]
[--verbose]
=head1 DESCRIPTION
I<installhtml> converts a collection of POD pages to a corresponding
collection of HTML pages. This is primarily used to convert the pod
pages found in the perl distribution.
=head1 OPTIONS
=over 4
=item B<--help> help
Displays the usage.
=item B<--podroot> POD search path base directory
The base directory to search for all .pod and .pm files to be converted.
Default is current directory.
=item B<--podpath> POD search path
The list of directories to search for .pod and .pm files to be converted.
Default is `podroot/.'.
=item B<--recurse> recurse on subdirectories
Whether or not to convert all .pm and .pod files found in subdirectories
too. Default is to not recurse.
=item B<--htmldir> HTML destination directory
The base directory which all HTML files will be written to. This should
be a path relative to the filesystem, not the resulting URL.
=item B<--htmlroot> URL base directory
The base directory which all resulting HTML files will be visible at in
a URL. The default is `/'.
=item B<--splithead> POD files to split on =head directive
Comma-separated list of pod files to split by the =head directive. The
.pod suffix is optional. These files should have names specified
relative to podroot.
=item B<--splititem> POD files to split on =item directive
Comma-separated list of all pod files to split by the =item directive.
The .pod suffix is optional. I<installhtml> does not do the actual
split, rather it invokes I<splitpod> to do the dirty work. As with
--splithead, these files should have names specified relative to podroot.
=item B<--splitpod> Directory containing the splitpod program
The directory containing the splitpod program. The default is `podroot/pod'.
=item B<--libpods> library PODs for LE<lt>E<gt> links
Comma-separated list of "library" pod files. This is the same list that
will be passed to pod2html when any pod is converted.
=item B<--ignore> files to be ignored
Comma-separated of files that shouldn't be installed, given relative
to podroot.
=item B<--verbose> verbose output
Self-explanatory.
=back
=head1 EXAMPLE
The following command-line is an example of the one we use to convert
perl documentation:
./installhtml --podpath=lib:ext:pod:vms \
--podroot=/usr/src/perl \
--htmldir=/perl/nmanual \
--htmlroot=/perl/nmanual \
--splithead=pod/perlipc \
--splititem=pod/perlfunc \
--libpods=perlfunc,perlguts,perlvar,perlrun,perlop \
--recurse \
--verbose
=head1 AUTHOR
Chris Hall E<lt>hallc at cs.colorado.eduE<gt>
=head1 TODO
=cut
my $usage;
$usage =<<END_OF_USAGE;
Usage: $0 --help --podpath=<name>:...:<name> --podroot=<name>
--htmldir=<name> --htmlroot=<name> --norecurse --recurse
--splithead=<name>,...,<name> --splititem=<name>,...,<name>
--libpods=<name>,...,<name> --ignore=<name>,...,<name> --verbose
--help - this message
--podpath - colon-separated list of directories containing .pod and
.pm files to be converted (. by default).
--podroot - filesystem base directory from which all relative paths in
podpath stem (default is .).
--htmldir - directory to store resulting html files in relative
to the filesystem (\$podroot/html by default).
--htmlroot - http-server base directory from which all relative paths
in podpath stem (default is /).
--libpods - comma-separated list of files to search for =item pod
directives in as targets of C<> and implicit links (empty
by default).
--norecurse - don't recurse on those subdirectories listed in podpath.
(default behavior).
--recurse - recurse on those subdirectories listed in podpath
--splithead - comma-separated list of .pod or .pm files to split. will
split each file into several smaller files at every occurrence
of a pod =head[1-6] directive.
--splititem - comma-separated list of .pod or .pm files to split using
splitpod.
--splitpod - directory where the program splitpod can be found
(\$podroot/pod by default).
--ignore - comma-separated list of files that shouldn't be installed.
--verbose - self-explanatory.
END_OF_USAGE
my (@libpods, @podpath, $podroot, $htmldir, $htmlroot, $recurse, @splithead,
@splititem, $splitpod, $verbose, $pod2html, @ignore);
@libpods = ();
@podpath = ( "." ); # colon-separated list of directories containing .pod
# and .pm files to be converted.
$podroot = "."; # assume the pods we want are here
$htmldir = ""; # nothing for now...
$htmlroot = "/"; # default value
$recurse = 0; # default behavior
@splithead = (); # don't split any files by default
@splititem = (); # don't split any files by default
$splitpod = ""; # nothing for now.
$verbose = 0; # whether or not to print debugging info
$pod2html = "pod/pod2html";
usage("") unless @ARGV;
# Overcome shell's p1,..,p8 limitation.
# See vms/descrip_mms.template -> descrip.mms for invokation.
if ( $^O eq 'VMS' ) { @ARGV = split(/\s+/,$ARGV[0]); }
use vars qw( %Options );
# parse the command-line
my $result = GetOptions( \%Options, qw(
help
podpath=s
podroot=s
htmldir=s
htmlroot=s
libpods=s
ignore=s
recurse!
splithead=s
splititem=s
splitpod=s
verbose
));
usage("invalid parameters") unless $result;
parse_command_line();
# set these variables to appropriate values if the user didn't specify
# values for them.
$htmldir = "$htmlroot/html" unless $htmldir;
$splitpod = "$podroot/pod" unless $splitpod;
# make sure that the destination directory exists
(mkdir($htmldir, 0755) ||
die "$0: cannot make directory $htmldir: $!\n") if ! -d $htmldir;
# the following array will eventually contain files that are to be
# ignored in the conversion process. these are files that have been
# process by splititem or splithead and should not be converted as a
# result.
my @splitdirs;
# split pods. It's important to do this before convert ANY pods because
# it may affect some of the links
@splitdirs = (); # files in these directories won't get an index
split_on_head($podroot, $htmldir, \@splitdirs, \@ignore, @splithead);
split_on_item($podroot, \@splitdirs, \@ignore, @splititem);
# convert the pod pages found in @poddirs
#warn "converting files\n" if $verbose;
#warn "\@ignore\t= @ignore\n" if $verbose;
foreach my $dir (@podpath) {
installdir($dir, $recurse, $podroot, \@splitdirs, \@ignore);
}
# now go through and create master indices for each pod we split
foreach my $dir (@splititem) {
print "creating index $htmldir/$dir.html\n" if $verbose;
create_index("$htmldir/$dir.html", "$htmldir/$dir");
}
foreach my $dir (@splithead) {
(my $pod = $dir) =~ s,^.*/,,;
$dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/;
# let pod2html create the file
runpod2html($dir, 1);
# now go through and truncate after the index
$dir =~ /^(.*?)(\.pod|\.pm)?$/sm;
my $file = "$htmldir/$1";
print "creating index $file.html\n" if $verbose;
# read in everything until what would have been the first =head
# directive, patching the index as we go.
open(H, "<$file.html") ||
die "$0: error opening $file.html for input: $!\n";
$/ = "";
my @data = ();
while (<H>) {
last if /name="name"/i;
$_ =~ s{href="#(.*)">}{
my $url = "$pod/$1.html" ;
$url = Pod::Html::relativize_url( $url, "$file.html" )
if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' );
"href=\"$url\">" ;
}egi;
push @data, $_;
}
close(H);
# now rewrite the file
open(H, ">$file.html") ||
die "$0: error opening $file.html for output: $!\n";
print H "@data", "\n";
close(H);
}
##############################################################################
sub usage {
warn "$0: @_\n" if @_;
die $usage;
}
sub parse_command_line {
usage() if defined $Options{help};
$Options{help} = ""; # make -w shut up
# list of directories
@podpath = split(":", $Options{podpath}) if defined $Options{podpath};
# lists of files
@splithead = split(",", $Options{splithead}) if defined $Options{splithead};
@splititem = split(",", $Options{splititem}) if defined $Options{splititem};
@libpods = split(",", $Options{libpods}) if defined $Options{libpods};
$htmldir = $Options{htmldir} if defined $Options{htmldir};
$htmlroot = $Options{htmlroot} if defined $Options{htmlroot};
$podroot = $Options{podroot} if defined $Options{podroot};
$splitpod = $Options{splitpod} if defined $Options{splitpod};
$recurse = $Options{recurse} if defined $Options{recurse};
$verbose = $Options{verbose} if defined $Options{verbose};
@ignore = map "$podroot/$_", split(",", $Options{ignore}) if defined $Options{ignore};
}
sub create_index {
my($html, $dir) = @_;
(my $pod = $dir) =~ s,^.*/,,;
my(@files, @filedata, @index, $file);
my($lcp1,$lcp2);
# get the list of .html files in this directory
opendir(DIR, $dir) ||
die "$0: error opening directory $dir for reading: $!\n";
@files = sort(grep(/\.html?$/, readdir(DIR)));
closedir(DIR);
open(HTML, ">$html") ||
die "$0: error opening $html for output: $!\n";
# for each .html file in the directory, extract the index
# embedded in the file and throw it into the big index.
print HTML "<DL COMPACT>\n";
foreach $file (@files) {
$/ = "";
open(IN, "<$dir/$file") ||
die "$0: error opening $dir/$file for input: $!\n";
@filedata = <IN>;
close(IN);
# pull out the NAME section
my $name;
($name) = grep(/name="name"/i, @filedata);
($lcp1,$lcp2) = ($name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,smi);
if (defined $lcp1 and $lcp1 =~ m,^<P>$,i) { # Uninteresting. Try again.
($lcp1,$lcp2) = ($name =~ m,/H1>\s<P>\s*(\S+)\s[\s-]*(.*?)\s*$,smi);
}
my $url= "$pod/$file" ;
if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' ) {
$url = Pod::Html::relativize_url( "$pod/$file", $html ) ;
}
if (defined $lcp1) {
print HTML qq(<DT><A HREF="$url">);
print HTML "$lcp1</A></DT><DD>$lcp2</DD>\n";
}
next;
@index = grep(/<!-- INDEX BEGIN -->.*<!-- INDEX END -->/s,
@filedata);
for (@index) {
s/<!-- INDEX BEGIN -->(\s*<!--)(.*)(-->\s*)<!-- INDEX END -->/$lcp2/s;
s,#,$dir/$file#,g;
print HTML "$_\n<P><HR><P>\n";
}
}
print HTML "</DL>\n";
close(HTML);
}
sub split_on_head {
my($podroot, $htmldir, $splitdirs, $ignore, @splithead) = @_;
my($pod, $dirname, $filename);
# split the files specified in @splithead on =head[1-6] pod directives
print "splitting files by head.\n" if $verbose && $#splithead >= 0;
foreach $pod (@splithead) {
# figure out the directory name and filename
$pod =~ s,^([^/]*)$,/$1,;
$pod =~ m,(.*)/(.*?)(\.pod)?$,;
$dirname = $1;
$filename = "$2.pod";
# since we are splitting this file it shouldn't be converted.
push(@$ignore, "$podroot/$dirname/$filename");
# split the pod
splitpod("$podroot/$dirname/$filename", "$podroot/$dirname", $htmldir,
$splitdirs);
}
}
sub split_on_item {
my($podroot, $splitdirs, $ignore, @splititem) = @_;
my($pwd, $dirname, $filename);
print "splitting files by item.\n" if $verbose && $#splititem >= 0;
$pwd = getcwd();
my $splitter = File::Spec->rel2abs("$splitpod/splitpod", $pwd);
my $perl = File::Spec->rel2abs($^X, $pwd);
foreach my $pod (@splititem) {
# figure out the directory to split into
$pod =~ s,^([^/]*)$,/$1,;
$pod =~ m,(.*)/(.*?)(\.pod)?$,;
$dirname = "$1/$2";
$filename = "$2.pod";
# since we are splitting this file it shouldn't be converted.
push(@$ignore, "$podroot/$dirname.pod");
# split the pod
push(@$splitdirs, "$podroot/$dirname");
if (! -d "$podroot/$dirname") {
mkdir("$podroot/$dirname", 0755) ||
die "$0: error creating directory $podroot/$dirname: $!\n";
}
chdir("$podroot/$dirname") ||
die "$0: error changing to directory $podroot/$dirname: $!\n";
die "$splitter not found. Use '-splitpod dir' option.\n"
unless -f $splitter;
system($perl, $splitter, "../$filename") &&
warn "$0: error running '$splitter ../$filename'"
." from $podroot/$dirname";
}
chdir($pwd);
}
#
# splitpod - splits a .pod file into several smaller .pod files
# where a new file is started each time a =head[1-6] pod directive
# is encountered in the input file.
#
sub splitpod {
my($pod, $poddir, $htmldir, $splitdirs) = @_;
my(@poddata, @filedata, @heads);
my($file, $i, $j, $prevsec, $section, $nextsec);
print "splitting $pod\n" if $verbose;
# read the file in paragraphs
$/ = "";
open(SPLITIN, "<$pod") ||
die "$0: error opening $pod for input: $!\n";
@filedata = <SPLITIN>;
close(SPLITIN) ||
die "$0: error closing $pod: $!\n";
# restore the file internally by =head[1-6] sections
@poddata = ();
for ($i = 0, $j = -1; $i <= $#filedata; $i++) {
$j++ if ($filedata[$i] =~ /^\s*=head[1-6]/);
if ($j >= 0) {
$poddata[$j] = "" unless defined $poddata[$j];
$poddata[$j] .= "\n$filedata[$i]" if $j >= 0;
}
}
# create list of =head[1-6] sections so that we can rewrite
# L<> links as necessary.
my %heads = ();
foreach $i (0..$#poddata) {
$heads{anchorify($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/;
}
# create a directory of a similar name and store all the
# files in there
$pod =~ s,.*/(.*),$1,; # get the last part of the name
my $dir = $pod;
$dir =~ s/\.pod//g;
push(@$splitdirs, "$poddir/$dir");
mkdir("$poddir/$dir", 0755) ||
die "$0: could not create directory $poddir/$dir: $!\n"
unless -d "$poddir/$dir";
$poddata[0] =~ /^\s*=head[1-6]\s+(.*)/;
$section = "";
$nextsec = $1;
# for each section of the file create a separate pod file
for ($i = 0; $i <= $#poddata; $i++) {
# determine the "prev" and "next" links
$prevsec = $section;
$section = $nextsec;
if ($i < $#poddata) {
$poddata[$i+1] =~ /^\s*=head[1-6]\s+(.*)/;
$nextsec = $1;
} else {
$nextsec = "";
}
# determine an appropriate filename (this must correspond with
# what pod2html will try and guess)
# $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/;
$file = "$dir/" . anchorify($section) . ".pod";
# create the new .pod file
print "\tcreating $poddir/$file\n" if $verbose;
open(SPLITOUT, ">$poddir/$file") ||
die "$0: error opening $poddir/$file for output: $!\n";
$poddata[$i] =~ s,L<([^<>]*)>,
defined $heads{anchorify($1)} ? "L<$dir/$1>" : "L<$1>"
,ge;
print SPLITOUT $poddata[$i]."\n\n";
print SPLITOUT "=over 4\n\n";
print SPLITOUT "=item *\n\nBack to L<$dir/\"$prevsec\">\n\n" if $prevsec;
print SPLITOUT "=item *\n\nForward to L<$dir/\"$nextsec\">\n\n" if $nextsec;
print SPLITOUT "=item *\n\nUp to L<$dir>\n\n";
print SPLITOUT "=back\n\n";
close(SPLITOUT) ||
die "$0: error closing $poddir/$file: $!\n";
}
}
#
# installdir - takes care of converting the .pod and .pm files in the
# current directory to .html files and then installing those.
#
sub installdir {
my($dir, $recurse, $podroot, $splitdirs, $ignore) = @_;
my(@dirlist, @podlist, @pmlist, $doindex);
@dirlist = (); # directories to recurse on
@podlist = (); # .pod files to install
@pmlist = (); # .pm files to install
# should files in this directory get an index?
$doindex = (grep($_ eq "$podroot/$dir", @$splitdirs) ? 0 : 1);
opendir(DIR, "$podroot/$dir")
|| die "$0: error opening directory $podroot/$dir: $!\n";
# find the directories to recurse on
@dirlist = map { if ($^O eq 'VMS') {/^(.*)\.dir$/i; "$dir/$1";} else {"$dir/$_";}}
grep(-d "$podroot/$dir/$_" && !/^\.{1,2}/, readdir(DIR)) if $recurse;
rewinddir(DIR);
# find all the .pod files within the directory
@podlist = map { /^(.*)\.pod$/; "$dir/$1" }
grep(! -d "$podroot/$dir/$_" && /\.pod$/, readdir(DIR));
rewinddir(DIR);
# find all the .pm files within the directory
@pmlist = map { /^(.*)\.pm$/; "$dir/$1" }
grep(! -d "$podroot/$dir/$_" && /\.pm$/, readdir(DIR));
closedir(DIR);
# recurse on all subdirectories we kept track of
foreach $dir (@dirlist) {
installdir($dir, $recurse, $podroot, $splitdirs, $ignore);
}
# install all the pods we found
foreach my $pod (@podlist) {
# check if we should ignore it.
next if $pod =~ m(/t/); # comes from a test file
next if grep($_ eq "$pod.pod", @$ignore);
# check if a .pm files exists too
if (grep($_ eq $pod, @pmlist)) {
print "$0: Warning both `$podroot/$pod.pod' and "
. "`$podroot/$pod.pm' exist, using pod\n";
push(@ignore, "$pod.pm");
}
runpod2html("$pod.pod", $doindex);
}
# install all the .pm files we found
foreach my $pm (@pmlist) {
# check if we should ignore it.
next if $pm =~ m(/t/); # comes from a test file
next if grep($_ eq "$pm.pm", @ignore);
runpod2html("$pm.pm", $doindex);
}
}
#
# runpod2html - invokes pod2html to convert a .pod or .pm file to a .html
# file.
#
sub runpod2html {
my($pod, $doindex) = @_;
my($html, $i, $dir, @dirs);
$html = $pod;
$html =~ s/\.(pod|pm)$/.html/g;
# make sure the destination directories exist
@dirs = split("/", $html);
$dir = "$htmldir/";
for ($i = 0; $i < $#dirs; $i++) {
if (! -d "$dir$dirs[$i]") {
mkdir("$dir$dirs[$i]", 0755) ||
die "$0: error creating directory $dir$dirs[$i]: $!\n";
}
$dir .= "$dirs[$i]/";
}
# invoke pod2html
print "$podroot/$pod => $htmldir/$html\n" if $verbose;
Pod::Html::pod2html(
"--htmldir=$htmldir",
"--htmlroot=$htmlroot",
"--podpath=".join(":", @podpath),
"--podroot=$podroot", "--netscape",
"--header",
($doindex ? "--index" : "--noindex"),
"--" . ($recurse ? "" : "no") . "recurse",
($#libpods >= 0) ? "--libpods=" . join(":", @libpods) : "",
"--infile=$podroot/$pod", "--outfile=$htmldir/$html");
die "$0: error running $pod2html: $!\n" if $?;
}
--- NEW FILE: makedepend.SH ---
#! /bin/sh
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting makedepend (with variable substitutions)"
rm -f makedepend
$spitshell >makedepend <<!GROK!THIS!
$startsh
# makedepend.SH
#
MAKE=$make
trnl='$trnl'
!GROK!THIS!
$spitshell >>makedepend <<'!NO!SUBS!'
if test -d .depending; then
echo "$0: Already running, exiting."
exit 0
fi
mkdir .depending
# This script should be called with
# sh ./makedepend MAKE=$(MAKE)
case "$1" in
MAKE=*) eval $1 ;;
esac
export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
# Avoid localized gcc messages
case "$ccname" in
gcc) LC_ALL=C ; export LC_ALL ;;
esac
# We need .. when we are in the x2p directory if we are using the
# cppstdin wrapper script.
# Put .. and . first so that we pick up the present cppstdin, not
# an older one lying about in /usr/local/bin.
PATH=".$path_sep..$path_sep$PATH"
export PATH
case "$osname" in
amigaos) cat=/bin/cat ;; # must be absolute
esac
$cat /dev/null >.deptmp
$rm -f *.c.c c/*.c.c
if test -f Makefile; then
rm -f $firstmakefile
cp Makefile $firstmakefile
# On QNX, 'cp' preserves timestamp, so $firstmakefile appears
# to be out of date. I don't know if OS/2 has touch, so do this:
case "$osname" in
os2) ;;
netbsd) ;;
*) $touch $firstmakefile ;;
esac
fi
mf=$firstmakefile
if test -f $mf; then
defrule=`<$mf sed -n \
-e '/^\.c\$(OBJ_EXT):.*;/{' \
-e 's/\$\*\.c//' \
-e 's/^[^;]*;[ ]*//p' \
-e q \
-e '}' \
-e '/^\.c\$(OBJ_EXT): *$/{' \
-e N \
-e 's/\$\*\.c//' \
-e 's/^.*\n[ ]*//p' \
-e q \
-e '}'`
fi
case "$defrule" in
'') defrule='$(CC) -c $(CFLAGS)' ;;
esac
: Create files in UU directory to avoid problems with long filenames
: on systems with 14 character filename limits so file.c.c and file.c
: might be identical
$test -d UU || mkdir UU
$MAKE clist || ($echo "Searching for .c files..."; \
$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
for file in `$cat .clist`; do
# for file in `cat /dev/null`; do
case "$osname" in
uwin) uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
os2) uwinfix="-e s,\\\\\\\\,/,g" ;;
cygwin) uwinfix="-e s,\\\\\\\\,/,g" ;;
posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
vos) uwinfix="-e s/\#/\\\#/" ;;
*) uwinfix="" ;;
esac
case "$file" in
*.c) filebase=`basename $file .c` ;;
*.y) filebase=`basename $file .y` ;;
esac
case "$file" in
*/*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
*) finc= ;;
esac
$echo "Finding dependencies for $filebase$_o."
( $echo "#line 1 \"$file\""; \
$sed -n <$file \
-e "/^${filebase}_init(/q" \
-e '/^#line/d' \
-e '/^#/{' \
-e 's|/\*.*$||' \
-e 's|\\$||' \
-e p \
-e '}' ) >UU/$file.c
if [ "$osname" = os390 -a "$file" = perly.c ]; then
$echo '#endif' >>UU/$file.c
fi
if [ "$osname" = os390 ]; then
$cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
$sed \
-e '/^#.*<stdin>/d' \
-e '/^#.*"-"/d' \
-e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
-e 's/^[ ]*#[ ]*line/#/' \
-e '/^# *[0-9][0-9]* *[".\/]/!d' \
-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
-e 's|\.c\.c|.c|' $uwinfix | \
$uniq | $sort | $uniq >> .deptmp
else
$cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
$sed \
-e '1d' \
-e '/^#.*<stdin>/d' \
-e '/^#.*<builtin>/d' \
-e '/^#.*<built-in>/d' \
-e '/^#.*<command line>/d' \
-e '/^#.*"-"/d' \
-e '/: file path prefix .* never used$/d' \
-e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
-e 's/^[ ]*#[ ]*line/#/' \
-e '/^# *[0-9][0-9]* *[".\/]/!d' \
-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
-e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
$uniq | $sort | $uniq >> .deptmp
fi
done
$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
$MAKE shlist || ($echo "Searching for .SH files..."; \
$echo *.SH | $tr ' ' $trnl | $egrep -v '\*' >.shlist)
# Now extract the dependencies on makedepend.SH and Makefile.SH
# (they should reside in the main Makefile):
rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^makedepend\.SH' <.shlist.old >.shlist
rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^Makefile\.SH' <.shlist.old >.shlist
rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^perl_exp\.SH' <.shlist.old >.shlist
rm -f .shlist.old
mv .shlist .shlist.old
$egrep -v '^config_h\.SH' <.shlist.old >.shlist
rm .shlist.old
if $test -s .deptmp; then
for file in `cat .shlist`; do
$echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \
$sh $file >> .deptmp
done
$echo "Updating $mf..."
$echo "# If this runs make out of memory, delete /usr/include lines." \
>> $mf.new
$sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
>>$mf.new
else
$MAKE hlist || ($echo "Searching for .h files..."; \
$echo *.h | $tr ' ' $trnl | $egrep -v '\*' >.hlist)
$echo "You don't seem to have a proper C preprocessor. Using grep instead."
$egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp
$echo "Updating $mf..."
<.clist $sed -n \
-e '/\//{' \
-e 's|^\(.*\)/\(.*\)\.c|\2\$(OBJ_EXT): \1/\2.c; '"$defrule \1/\2.c|p" \
-e d \
-e '}' \
-e 's|^\(.*\)\.c|\1\$(OBJ_EXT): \1.c|p' >> $mf.new
<.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
<.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
$sed 's|^[^;]*/||' | \
$sed -f .hsed >> $mf.new
<.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
$sed -f .hsed >> $mf.new
for file in `$cat .shlist`; do
$echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \
$sh $file >> $mf.new
done
fi
$rm -f $mf.old
$cp $mf $mf.old
$rm -f $mf
$cp $mf.new $mf
$rm $mf.new
$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
rmdir .depending
!NO!SUBS!
$eunicefix makedepend
chmod +x makedepend
case `pwd` in
*SH)
$rm -f ../makedepend
ln makedepend ../makedepend
;;
esac
--- NEW FILE: pad.c ---
/* pad.c
*
* Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* "Anyway: there was this Mr Frodo left an orphan and stranded, as you
* might say, among those queer Bucklanders, being brought up anyhow in
* Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
* never had fewer than a couple of hundred relations in the place. Mr
* Bilbo never did a kinder deed than when he brought the lad back to
* live among decent folk." --the Gaffer
*/
/* XXX DAPM
* As of Sept 2002, this file is new and may be in a state of flux for
* a while. I've marked things I intent to come back and look at further
* with an 'XXX DAPM' comment.
[...1539 lines suppressed...]
HV *
Perl_pad_compname_type(pTHX_ const PADOFFSET po)
{
SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
if ( SvFLAGS(*av) & SVpad_TYPED ) {
return SvSTASH(*av);
}
return Nullhv;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: thread.h ---
/* thread.h
*
* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2005
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
#if defined(VMS)
#include <builtins.h>
#endif
#ifdef WIN32
# include <win32thread.h>
#else
#ifdef NETWARE
# include <nw5thread.h>
#else
# ifdef OLD_PTHREADS_API /* Here be dragons. */
# define DETACH(t) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_detach(&(t)->self))) { \
MUTEX_UNLOCK(&(t)->mutex); \
Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} \
} STMT_END
# define PERL_GET_CONTEXT Perl_get_context()
# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t)
# define PTHREAD_GETSPECIFIC_INT
# ifdef DJGPP
# define pthread_addr_t any_t
# define NEED_PTHREAD_INIT
# define PTHREAD_CREATE_JOINABLE (1)
# endif
# ifdef __OPEN_VM
# define pthread_addr_t void *
# endif
# ifdef OEMVS
# define pthread_addr_t void *
# define pthread_create(t,a,s,d) pthread_create(t,&(a),s,d)
# define pthread_keycreate pthread_key_create
# endif
# ifdef VMS
# define pthread_attr_init(a) pthread_attr_create(a)
# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_setdetach_np(a,s)
# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
# endif
# if defined(__hpux) && defined(__ux_version) && __ux_version <= 1020
# define pthread_attr_init(a) pthread_attr_create(a)
/* XXX pthread_setdetach_np() missing in DCE threads on HP-UX 10.20 */
# define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0)
# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
# endif
# if defined(DJGPP) || defined(__OPEN_VM) || defined(OEMVS)
# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s))
# define YIELD pthread_yield(NULL)
# endif
# endif
# if !defined(__hpux) || !defined(__ux_version) || __ux_version > 1020
# define pthread_mutexattr_default NULL
# define pthread_condattr_default NULL
# endif
#endif /* NETWARE */
#endif
#ifndef PTHREAD_CREATE
/* You are not supposed to pass NULL as the 2nd arg of PTHREAD_CREATE(). */
# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d)
#endif
#ifndef PTHREAD_ATTR_SETDETACHSTATE
# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,s)
#endif
#ifndef PTHREAD_CREATE_JOINABLE
# ifdef OLD_PTHREAD_CREATE_JOINABLE
# define PTHREAD_CREATE_JOINABLE OLD_PTHREAD_CREATE_JOINABLE
# else
# define PTHREAD_CREATE_JOINABLE 0 /* Panic? No, guess. */
# endif
#endif
#ifdef DGUX
# define THREAD_CREATE_NEEDS_STACK (32*1024)
#endif
#ifdef I_MACH_CTHREADS
/* cthreads interface */
/* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */
#define MUTEX_INIT(m) \
STMT_START { \
*m = mutex_alloc(); \
if (*m) { \
mutex_init(*m); \
} else { \
Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \
__FILE__, __LINE__); \
} \
} STMT_END
#define MUTEX_LOCK(m) mutex_lock(*m)
#define MUTEX_UNLOCK(m) mutex_unlock(*m)
#define MUTEX_DESTROY(m) \
STMT_START { \
mutex_free(*m); \
*m = 0; \
} STMT_END
#define COND_INIT(c) \
STMT_START { \
*c = condition_alloc(); \
if (*c) { \
condition_init(*c); \
} \
else { \
Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \
__FILE__, __LINE__); \
} \
} STMT_END
#define COND_SIGNAL(c) condition_signal(*c)
#define COND_BROADCAST(c) condition_broadcast(*c)
#define COND_WAIT(c, m) condition_wait(*c, *m)
#define COND_DESTROY(c) \
STMT_START { \
condition_free(*c); \
*c = 0; \
} STMT_END
#define THREAD_CREATE(thr, f) (thr->self = cthread_fork(f, thr), 0)
#define THREAD_POST_CREATE(thr)
#define THREAD_RET_TYPE any_t
#define THREAD_RET_CAST(x) ((any_t) x)
#define DETACH(t) cthread_detach(t->self)
#define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self))
#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t)
#define PERL_GET_CONTEXT cthread_data(cthread_self())
#define INIT_THREADS cthread_init()
#define YIELD cthread_yield()
#define ALLOC_THREAD_KEY NOOP
#define FREE_THREAD_KEY NOOP
#define SET_THREAD_SELF(thr) (thr->self = cthread_self())
#endif /* I_MACH_CTHREADS */
#ifndef YIELD
# ifdef SCHED_YIELD
# define YIELD SCHED_YIELD
# else
# ifdef HAS_SCHED_YIELD
# define YIELD sched_yield()
# else
# ifdef HAS_PTHREAD_YIELD
/* pthread_yield(NULL) platforms are expected
* to have #defined YIELD for themselves. */
# define YIELD pthread_yield()
# endif
# endif
# endif
#endif
#ifdef __hpux
# define MUTEX_INIT_NEEDS_MUTEX_ZEROED
#endif
#ifndef MUTEX_INIT
# ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
/* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */
# define MUTEX_INIT(m) \
STMT_START { \
int _eC_; \
Zero((m), 1, perl_mutex); \
if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \
Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# else
# define MUTEX_INIT(m) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \
Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# endif
# define MUTEX_LOCK(m) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_mutex_lock((m)))) \
Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define MUTEX_UNLOCK(m) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_mutex_unlock((m)))) \
Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define MUTEX_DESTROY(m) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_mutex_destroy((m)))) \
Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
#endif /* MUTEX_INIT */
#ifndef COND_INIT
# define COND_INIT(c) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \
Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define COND_SIGNAL(c) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_cond_signal((c)))) \
Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define COND_BROADCAST(c) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_cond_broadcast((c)))) \
Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define COND_WAIT(c, m) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_cond_wait((c), (m)))) \
Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
# define COND_DESTROY(c) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_cond_destroy((c)))) \
Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
#endif /* COND_INIT */
/* DETACH(t) must only be called while holding t->mutex */
#ifndef DETACH
# define DETACH(t) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_detach((t)->self))) { \
MUTEX_UNLOCK(&(t)->mutex); \
Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} \
} STMT_END
#endif /* DETACH */
#ifndef JOIN
# define JOIN(t, avp) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \
Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
#endif /* JOIN */
/* Use an unchecked fetch of thread-specific data instead of a checked one.
* It would fail if the key were bogus, but if the key were bogus then
* Really Bad Things would be happening anyway. --dan */
#if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \
(defined(__alpha) && defined(__osf__) && !defined(__GNUC__)) /* Available only on >= 4.0 */
# define HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP /* Configure test needed */
#endif
#ifdef HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP
# define PTHREAD_GETSPECIFIC(key) pthread_unchecked_getspecific_np(key)
#else
# define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key)
#endif
#ifndef PERL_GET_CONTEXT
# define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key)
#endif
#ifndef PERL_SET_CONTEXT
# define PERL_SET_CONTEXT(t) \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_setspecific(PL_thr_key, (void *)(t)))) \
Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \
_eC_, __FILE__, __LINE__); \
} STMT_END
#endif /* PERL_SET_CONTEXT */
#ifndef INIT_THREADS
# ifdef NEED_PTHREAD_INIT
# define INIT_THREADS pthread_init()
# endif
#endif
#ifndef ALLOC_THREAD_KEY
# define ALLOC_THREAD_KEY \
STMT_START { \
int _eC_; \
if ((_eC_ = pthread_key_create(&PL_thr_key, 0))) { \
write(2, "panic: pthread_key_create failed\n", 33); \
exit(1); \
} \
} STMT_END
#endif
#ifndef FREE_THREAD_KEY
# define FREE_THREAD_KEY \
STMT_START { \
pthread_key_delete(PL_thr_key); \
} STMT_END
#endif
#ifndef PTHREAD_ATFORK
# ifdef HAS_PTHREAD_ATFORK
# define PTHREAD_ATFORK(prepare,parent,child) \
pthread_atfork(prepare,parent,child)
# else
# define PTHREAD_ATFORK(prepare,parent,child) \
NOOP
# endif
#endif
#ifndef THREAD_RET_TYPE
# define THREAD_RET_TYPE void *
# define THREAD_RET_CAST(p) ((void *)(p))
#endif /* THREAD_RET */
#if defined(USE_5005THREADS)
/* Accessor for per-thread SVs */
# define THREADSV(i) (thr->threadsvp[i])
/*
* LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
* try only locking them if there may be more than one thread in existence.
* Systems with very fast mutexes (and/or slow conditionals) may wish to
* remove the "if (threadnum) ..." test.
* XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
*/
# define LOCK_SV_MUTEX MUTEX_LOCK(&PL_sv_mutex)
# define UNLOCK_SV_MUTEX MUTEX_UNLOCK(&PL_sv_mutex)
# define LOCK_STRTAB_MUTEX MUTEX_LOCK(&PL_strtab_mutex)
# define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex)
# define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex)
# define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex)
# define LOCK_FDPID_MUTEX MUTEX_LOCK(&PL_fdpid_mutex)
# define UNLOCK_FDPID_MUTEX MUTEX_UNLOCK(&PL_fdpid_mutex)
# define LOCK_SV_LOCK_MUTEX MUTEX_LOCK(&PL_sv_lock_mutex)
# define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex)
/* Values and macros for thr->flags */
#define THRf_STATE_MASK 7
#define THRf_R_JOINABLE 0
#define THRf_R_JOINED 1
#define THRf_R_DETACHED 2
#define THRf_ZOMBIE 3
#define THRf_DEAD 4
#define THRf_DID_DIE 8
/* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
#define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
#define ThrSETSTATE(t, s) STMT_START { \
(t)->flags &= ~THRf_STATE_MASK; \
(t)->flags |= (s); \
DEBUG_S(PerlIO_printf(Perl_debug_log, \
"thread %p set to state %d\n", (t), (s))); \
} STMT_END
typedef struct condpair {
perl_mutex mutex; /* Protects all other fields */
perl_cond owner_cond; /* For when owner changes at all */
perl_cond cond; /* For cond_signal and cond_broadcast */
Thread owner; /* Currently owning thread */
} condpair_t;
#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
#endif /* USE_5005THREADS */
# define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex)
# define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex)
#endif /* USE_5005THREADS || USE_ITHREADS */
#ifndef MUTEX_LOCK
# define MUTEX_LOCK(m)
#endif
#ifndef MUTEX_UNLOCK
# define MUTEX_UNLOCK(m)
#endif
#ifndef MUTEX_INIT
# define MUTEX_INIT(m)
#endif
#ifndef MUTEX_DESTROY
# define MUTEX_DESTROY(m)
#endif
#ifndef COND_INIT
# define COND_INIT(c)
#endif
#ifndef COND_SIGNAL
# define COND_SIGNAL(c)
#endif
#ifndef COND_BROADCAST
# define COND_BROADCAST(c)
#endif
#ifndef COND_WAIT
# define COND_WAIT(c, m)
#endif
#ifndef COND_DESTROY
# define COND_DESTROY(c)
#endif
#ifndef LOCK_SV_MUTEX
# define LOCK_SV_MUTEX
#endif
#ifndef UNLOCK_SV_MUTEX
# define UNLOCK_SV_MUTEX
#endif
#ifndef LOCK_STRTAB_MUTEX
# define LOCK_STRTAB_MUTEX
#endif
#ifndef UNLOCK_STRTAB_MUTEX
# define UNLOCK_STRTAB_MUTEX
#endif
#ifndef LOCK_CRED_MUTEX
# define LOCK_CRED_MUTEX
#endif
#ifndef UNLOCK_CRED_MUTEX
# define UNLOCK_CRED_MUTEX
#endif
#ifndef LOCK_FDPID_MUTEX
# define LOCK_FDPID_MUTEX
#endif
#ifndef UNLOCK_FDPID_MUTEX
# define UNLOCK_FDPID_MUTEX
#endif
#ifndef LOCK_SV_LOCK_MUTEX
# define LOCK_SV_LOCK_MUTEX
#endif
#ifndef UNLOCK_SV_LOCK_MUTEX
# define UNLOCK_SV_LOCK_MUTEX
#endif
#ifndef LOCK_DOLLARZERO_MUTEX
# define LOCK_DOLLARZERO_MUTEX
#endif
#ifndef UNLOCK_DOLLARZERO_MUTEX
# define UNLOCK_DOLLARZERO_MUTEX
#endif
/* THR, SET_THR, and dTHR are there for compatibility with old versions */
#ifndef THR
# define THR PERL_GET_THX
#endif
#ifndef SET_THR
# define SET_THR(t) PERL_SET_THX(t)
#endif
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef INIT_THREADS
# define INIT_THREADS NOOP
#endif
--- NEW FILE: perlsdio.h ---
/* perlsdio.h
*
* Copyright (C) 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef PERLIO_IS_STDIO
#ifdef NETWARE
#include "nwstdio.h"
#else
/*
* This file #define-s the PerlIO_xxx abstraction onto stdio functions.
* Make this as close to original stdio as possible.
*/
#define PerlIO FILE
#define PerlIO_stderr() PerlSIO_stderr
#define PerlIO_stdout() PerlSIO_stdout
#define PerlIO_stdin() PerlSIO_stdin
#define PerlIO_isutf8(f) 0
#define PerlIO_printf PerlSIO_printf
#define PerlIO_stdoutf PerlSIO_stdoutf
#define PerlIO_vprintf(f,fmt,a) PerlSIO_vprintf(f,fmt,a)
#define PerlIO_write(f,buf,count) PerlSIO_fwrite(buf,1,count,f)
#define PerlIO_unread(f,buf,count) (-1)
#define PerlIO_open PerlSIO_fopen
#define PerlIO_fdopen PerlSIO_fdopen
#define PerlIO_reopen PerlSIO_freopen
#define PerlIO_close(f) PerlSIO_fclose(f)
#define PerlIO_puts(f,s) PerlSIO_fputs(f,s)
#define PerlIO_putc(f,c) PerlSIO_fputc(f,c)
#if defined(VMS)
# if defined(__DECC)
/* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
* belief that it can mix getc/ungetc with reads from stdio buffer */
int decc$ungetc(int __c, FILE *__stream);
# define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \
((*(f) && !((*(f))->_flag & _IONBF) && \
((*(f))->_ptr > (*(f))->_base)) ? \
((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f)))
# else
# define PerlIO_ungetc(f,c) ungetc(c,f)
# endif
/* Work around bug in DECCRTL/AXP (DECC v5.x) and some versions of old
* VAXCRTL which causes read from a pipe after EOF has been returned
* once to hang.
*/
# define PerlIO_getc(f) \
(feof(f) ? EOF : getc(f))
# define PerlIO_read(f,buf,count) \
(feof(f) ? 0 : (SSize_t)fread(buf,1,count,f))
# define PerlIO_tell(f) ftell(f)
#else
# define PerlIO_getc(f) PerlSIO_fgetc(f)
# define PerlIO_ungetc(f,c) PerlSIO_ungetc(c,f)
# define PerlIO_read(f,buf,count) (SSize_t)PerlSIO_fread(buf,1,count,f)
# define PerlIO_tell(f) PerlSIO_ftell(f)
#endif
#define PerlIO_eof(f) PerlSIO_feof(f)
#define PerlIO_getname(f,b) fgetname(f,b)
#define PerlIO_error(f) PerlSIO_ferror(f)
#define PerlIO_fileno(f) PerlSIO_fileno(f)
#define PerlIO_clearerr(f) PerlSIO_clearerr(f)
#define PerlIO_flush(f) PerlSIO_fflush(f)
#if defined(VMS) && !defined(__DECC)
/* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */
#define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w))
#else
# define PerlIO_seek(f,o,w) PerlSIO_fseek(f,o,w)
#endif
#define PerlIO_rewind(f) PerlSIO_rewind(f)
#define PerlIO_tmpfile() PerlSIO_tmpfile()
#define PerlIO_importFILE(f,fl) (f)
#define PerlIO_exportFILE(f,fl) (f)
#define PerlIO_findFILE(f) (f)
#define PerlIO_releaseFILE(p,f) ((void) 0)
#ifdef HAS_SETLINEBUF
#define PerlIO_setlinebuf(f) PerlSIO_setlinebuf(f);
#else
#define PerlIO_setlinebuf(f) PerlSIO_setvbuf(f, Nullch, _IOLBF, 0);
#endif
/* Now our interface to Configure's FILE_xxx macros */
#ifdef USE_STDIO_PTR
#define PerlIO_has_cntptr(f) 1
#define PerlIO_get_ptr(f) PerlSIO_get_ptr(f)
#define PerlIO_get_cnt(f) PerlSIO_get_cnt(f)
#ifdef STDIO_CNT_LVALUE
#define PerlIO_canset_cnt(f) 1
#define PerlIO_set_cnt(f,c) PerlSIO_set_cnt(f,c)
#ifdef STDIO_PTR_LVALUE
#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
#define PerlIO_fast_gets(f) 1
#endif
#endif /* STDIO_PTR_LVALUE */
#else /* STDIO_CNT_LVALUE */
#define PerlIO_canset_cnt(f) 0
#define PerlIO_set_cnt(f,c) abort()
#endif
#ifdef STDIO_PTR_LVALUE
#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
#define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p), PerlIO_set_cnt(f,c);} STMT_END
#else
#ifdef STDIO_PTR_LVAL_SETS_CNT
/* assert() may pre-process to ""; potential syntax error (FILE_ptr(), ) */
#define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p); assert(PerlSIO_get_cnt(f) == (c));} STMT_END
#define PerlIO_fast_gets(f) 1
#else
#define PerlIO_set_ptrcnt(f,p,c) abort()
#endif
#endif
#endif
#else /* USE_STDIO_PTR */
#define PerlIO_has_cntptr(f) 0
#define PerlIO_canset_cnt(f) 0
#define PerlIO_get_cnt(f) (abort(),0)
#define PerlIO_get_ptr(f) (abort(),(void *)0)
#define PerlIO_set_cnt(f,c) abort()
#define PerlIO_set_ptrcnt(f,p,c) abort()
#endif /* USE_STDIO_PTR */
#ifndef PerlIO_fast_gets
#define PerlIO_fast_gets(f) 0
#endif
#ifdef FILE_base
#define PerlIO_has_base(f) 1
#define PerlIO_get_base(f) PerlSIO_get_base(f)
#define PerlIO_get_bufsiz(f) PerlSIO_get_bufsiz(f)
#else
#define PerlIO_has_base(f) 0
#define PerlIO_get_base(f) (abort(),(void *)0)
#define PerlIO_get_bufsiz(f) (abort(),0)
#endif
#endif /* NETWARE */
#endif /* PERLIO_IS_STDIO */
--- NEW FILE: pad.h ---
/* pad.h
*
* Copyright (C) 2002, 2003, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* This file defines the types and macros associated with the API for
* manipulating scratchpads, which are used by perl to store lexical
* variables, op targets and constants.
*/
/* a padlist is currently just an AV; but that might change,
* so hide the type. Ditto a pad. */
typedef AV PADLIST;
typedef AV PAD;
/* offsets within a pad */
#if PTRSIZE == 4
typedef U32TYPE PADOFFSET;
#else
# if PTRSIZE == 8
typedef U64TYPE PADOFFSET;
# endif
#endif
#define NOT_IN_PAD ((PADOFFSET) -1)
/* flags for the pad_new() function */
#define padnew_CLONE 1 /* this pad is for a cloned CV */
#define padnew_SAVE 2 /* save old globals */
#define padnew_SAVESUB 4 /* also save extra stuff for start of sub */
/* values for the pad_tidy() function */
typedef enum {
padtidy_SUB, /* tidy up a pad for a sub, */
padtidy_SUBCLONE, /* a cloned sub, */
padtidy_FORMAT /* or a format */
} padtidy_type;
/* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine
* whether PL_comppad and PL_curpad are consistent and whether they have
* active values */
#ifdef DEBUGGING
# define ASSERT_CURPAD_LEGAL(label) \
if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \
Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
# define ASSERT_CURPAD_ACTIVE(label) \
if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \
Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%"UVxf"[0x%"UVxf"]",\
label, PTR2UV(PL_comppad), PTR2UV(PL_curpad));
#else
# define ASSERT_CURPAD_LEGAL(label)
# define ASSERT_CURPAD_ACTIVE(label)
#endif
/* Note: the following three macros are actually defined in scope.h, but
* they are documented here for completeness, since they directly or
* indirectly affect pads.
=for apidoc m|void|SAVEPADSV |PADOFFSET po
Save a pad slot (used to restore after an iteration)
XXX DAPM it would make more sense to make the arg a PADOFFSET
=for apidoc m|void|SAVECLEARSV |SV **svp
Clear the pointed to pad value on scope exit. (i.e. the runtime action of 'my')
=for apidoc m|void|SAVECOMPPAD
save PL_comppad and PL_curpad
=for apidoc m|SV *|PAD_SETSV |PADOFFSET po|SV* sv
Set the slot at offset C<po> in the current pad to C<sv>
=for apidoc m|void|PAD_SV |PADOFFSET po
Get the value at offset C<po> in the current pad
=for apidoc m|SV *|PAD_SVl |PADOFFSET po
Lightweight and lvalue version of C<PAD_SV>.
Get or set the value at offset C<po> in the current pad.
Unlike C<PAD_SV>, does not print diagnostics with -DX.
For internal use only.
=for apidoc m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po
Get the value from slot C<po> in the base (DEPTH=1) pad of a padlist
=for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n
Set the current pad to be pad C<n> in the padlist, saving
the previous current pad. NB currently this macro expands to a string too
long for some compilers, so it's best to replace it with
SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(padlist,n);
=for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n
like PAD_SET_CUR, but without the save
=for apidoc m|void|PAD_SAVE_SETNULLPAD
Save the current pad then set it to null.
=for apidoc m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad
Save the current pad to the local variable opad, then make the
current pad equal to npad
=for apidoc m|void|PAD_RESTORE_LOCAL|PAD *opad
Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
=cut
*/
#ifdef DEBUGGING
# define PAD_SV(po) pad_sv(po)
# define PAD_SETSV(po,sv) pad_setsv(po,sv)
#else
# define PAD_SV(po) (PL_curpad[po])
# define PAD_SETSV(po,sv) PL_curpad[po] = (sv)
#endif
#define PAD_SVl(po) (PL_curpad[po])
#define PAD_BASE_SV(padlist, po) \
(AvARRAY(padlist)[1]) \
? AvARRAY((AV*)(AvARRAY(padlist)[1]))[po] : Nullsv;
#define PAD_SET_CUR_NOSAVE(padlist,n) \
PL_comppad = (PAD*) (AvARRAY(padlist)[n]); \
PL_curpad = AvARRAY(PL_comppad); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, \
"Pad 0x%"UVxf"[0x%"UVxf"] set_cur depth=%d\n", \
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(n)));
#define PAD_SET_CUR(padlist,n) \
SAVECOMPPAD(); \
PAD_SET_CUR_NOSAVE(padlist,n);
#define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \
PL_comppad = Null(PAD*); PL_curpad = Null(SV**); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n"));
#define PAD_SAVE_LOCAL(opad,npad) \
opad = PL_comppad; \
PL_comppad = (npad); \
PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, \
"Pad 0x%"UVxf"[0x%"UVxf"] save_local\n", \
PTR2UV(PL_comppad), PTR2UV(PL_curpad)));
#define PAD_RESTORE_LOCAL(opad) \
PL_comppad = opad; \
PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, \
"Pad 0x%"UVxf"[0x%"UVxf"] restore_local\n", \
PTR2UV(PL_comppad), PTR2UV(PL_curpad)));
/*
=for apidoc m|void|CX_CURPAD_SAVE|struct context
Save the current pad in the given context block structure.
=for apidoc m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po
Access the SV at offset po in the saved current pad in the given
context block structure (can be used as an lvalue).
=cut
*/
#define CX_CURPAD_SAVE(block) (block).oldcomppad = PL_comppad
#define CX_CURPAD_SV(block,po) (AvARRAY((AV*)((block).oldcomppad))[po])
/*
=for apidoc m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po
Return the flags for the current compiling pad name
at offset C<po>. Assumes a valid slot entry.
=for apidoc m|char *|PAD_COMPNAME_PV|PADOFFSET po
Return the name of the current compiling pad name
at offset C<po>. Assumes a valid slot entry.
=for apidoc m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po
Return the type (stash) of the current compiling pad name at offset
C<po>. Must be a valid name. Returns null if not typed.
=for apidoc m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po
Return the stash associated with an C<our> variable.
Assumes the slot entry is a valid C<our> lexical.
=for apidoc m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po
The generation number of the name at offset C<po> in the current
compiling pad (lvalue). Note that C<SvCUR> is hijacked for this purpose.
=for apidoc m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen
Sets the generation number of the name at offset C<po> in the current
ling pad (lvalue) to C<gen>. Note that C<SvCUR_set> is hijacked for this purpose.
=cut
*/
#define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE))
#define PAD_COMPNAME_PV(po) SvPV_nolen(*av_fetch(PL_comppad_name, (po), FALSE))
#define PAD_COMPNAME_TYPE(po) pad_compname_type(po)
#define PAD_COMPNAME_OURSTASH(po) \
(GvSTASH(*av_fetch(PL_comppad_name, (po), FALSE)))
#define PAD_COMPNAME_GEN(po) SvCUR(AvARRAY(PL_comppad_name)[po])
#define PAD_COMPNAME_GEN_set(po, gen) SvCUR_set(AvARRAY(PL_comppad_name)[po], gen)
/*
=for apidoc m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param
Clone a padlist.
=for apidoc m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl \
|CLONE_PARAMS* param
Clone the state variables associated with running and compiling pads.
=cut
*/
#define PAD_DUP(dstpad, srcpad, param) \
if ((srcpad) && !AvREAL(srcpad)) { \
/* XXX padlists are real, but pretend to be not */ \
AvREAL_on(srcpad); \
(dstpad) = av_dup_inc((srcpad), param); \
AvREAL_off(srcpad); \
AvREAL_off(dstpad); \
} \
else \
(dstpad) = av_dup_inc((srcpad), param);
/* NB - we set PL_comppad to null unless it points at a value that
* has already been dup'ed, ie it points to part of an active padlist.
* Otherwise PL_comppad ends up being a leaked scalar in code like
* the following:
* threads->create(sub { threads->create(sub {...} ) } );
* where the second thread dups the outer sub's comppad but not the
* sub's CV or padlist. */
#define PAD_CLONE_VARS(proto_perl, param) \
PL_comppad = ptr_table_fetch(PL_ptr_table, proto_perl->Tcomppad); \
PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \
PL_comppad_name = av_dup(proto_perl->Icomppad_name, param); \
PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \
PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \
PL_min_intro_pending = proto_perl->Imin_intro_pending; \
PL_max_intro_pending = proto_perl->Imax_intro_pending; \
PL_padix = proto_perl->Ipadix; \
PL_padix_floor = proto_perl->Ipadix_floor; \
PL_pad_reset_pending = proto_perl->Ipad_reset_pending; \
PL_cop_seqmax = proto_perl->Icop_seqmax;
--- NEW FILE: README.win32 ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specially designed to be readable as is.
=head1 NAME
perlwin32 - Perl under Windows
=head1 SYNOPSIS
These are instructions for building Perl under Windows 9x/NT/2000/XP
on the Intel x86 and Itanium architectures.
=head1 DESCRIPTION
Before you start, you should glance through the README file
found in the top-level directory to which the Perl distribution
was extracted. Make sure you read and understand the terms under
which this software is being distributed.
Also make sure you read L<BUGS AND CAVEATS> below for the
known limitations of this port.
The INSTALL file in the perl top-level has much information that is
only relevant to people building Perl on Unix-like systems. In
particular, you can safely ignore any information that talks about
"Configure".
You may also want to look at two other options for building
a perl that will work on Windows NT: the README.cygwin and
README.os2 files, each of which give a different set of rules to
build a Perl that will work on Win32 platforms. Those two methods
will probably enable you to build a more Unix-compatible perl, but
you will also need to download and use various other build-time and
run-time support software described in those files.
This set of instructions is meant to describe a so-called "native"
port of Perl to Win32 platforms. This includes both 32-bit and
64-bit Windows operating systems. The resulting Perl requires no
additional software to run (other than what came with your operating
system). Currently, this port is capable of using one of the
following compilers on the Intel x86 architecture:
Borland C++ version 5.02 or later
Microsoft Visual C++ version 2.0 or later
MinGW with gcc gcc version 2.95.2 or later
The last of these is a high quality freeware compiler. Use version
3.2.x or later for the best results with this compiler.
The Borland C++ and Microsoft Visual C++ compilers are also now being given
away free. The Borland compiler is available as "Borland C++ Compiler Free
Command Line Tools" and is the same compiler that ships with the full
"Borland C++ Builder" product. The Microsoft compiler is available as
"Visual C++ Toolkit 2003", and also as part of the ".NET Framework SDK", and
is the same compiler that ships with "Visual Studio .NET 2003 Professional".
This port can also be built on the Intel IA64 using:
Microsoft Platform SDK Nov 2001 (64-bit compiler and tools)
The MS Platform SDK can be downloaded from http://www.microsoft.com/.
This port fully supports MakeMaker (the set of modules that
is used to build extensions to perl). Therefore, you should be
able to build and install most extensions found in the CPAN sites.
See L<Usage Hints for Perl on Win32> below for general hints about this.
=head2 Setting Up Perl on Win32
=over 4
=item Make
You need a "make" program to build the sources. If you are using
Visual C++ or the Platform SDK tools under Windows NT/2000/XP, nmake
will work. All other builds need dmake.
dmake is a freely available make that has very nice macro features
and parallelability.
A port of dmake for Windows is available from:
http://search.cpan.org/dist/dmake/
Fetch and install dmake somewhere on your path.
There exists a minor coexistence problem with dmake and Borland C++
compilers. Namely, if a distribution has C files named with mixed
case letters, they will be compiled into appropriate .obj-files named
with all lowercase letters, and every time dmake is invoked
to bring files up to date, it will try to recompile such files again.
For example, Tk distribution has a lot of such files, resulting in
needless recompiles every time dmake is invoked. To avoid this, you
may use the script "sync_ext.pl" after a successful build. It is
available in the win32 subdirectory of the Perl source distribution.
=item Command Shell
Use the default "cmd" shell that comes with NT. Some versions of the
popular 4DOS/NT shell have incompatibilities that may cause you trouble.
If the build fails under that shell, try building again with the cmd
shell.
The nmake Makefile also has known incompatibilities with the
"command.com" shell that comes with Windows 9x. You will need to
use dmake and makefile.mk to build under Windows 9x.
The surest way to build it is on Windows NT/2000/XP, using the cmd shell.
Make sure the path to the build directory does not contain spaces. The
build usually works in this circumstance, but some tests will fail.
=item Borland C++
If you are using the Borland compiler, you will need dmake.
(The make that Borland supplies is seriously crippled and will not
work for MakeMaker builds.)
See L</"Make"> above.
=item Microsoft Visual C++
The nmake that comes with Visual C++ will suffice for building.
You will need to run the VCVARS32.BAT file, usually found somewhere
like C:\MSDEV4.2\BIN or C:\Program Files\Microsoft Visual Studio\VC98\Bin.
This will set your build environment.
You can also use dmake to build using Visual C++; provided, however,
you set OSRELEASE to "microsft" (or whatever the directory name
under which the Visual C dmake configuration lives) in your environment
and edit win32/config.vc to change "make=nmake" into "make=dmake". The
latter step is only essential if you want to use dmake as your default
make for building extensions using MakeMaker.
=item Microsoft Visual C++ Toolkit 2003
This free toolkit contains the same compiler and linker that ship with
Visual Studio .NET 2003 Professional, but doesn't contain everything
necessary to build Perl.
You will also need to download the "Platform SDK" (the "Core SDK" and "MDAC
SDK" components are required) for header files, libraries and rc.exe, and
".NET Framework SDK" for more libraries and nmake.exe. Note that the latter
(which also includes the free compiler and linker) requires the ".NET
Framework Redistributable" to be installed first. This can be downloaded and
installed separately, but is included in the "Visual C++ Toolkit 2003" anyway.
These packages can all be downloaded by searching in the Download Center at
http://www.microsoft.com/downloads/search.aspx?displaylang=en. (Providing exact
links to these packages has proven a pointless task because the links keep on
changing so often.)
Try to obtain the latest version of the Platform SDK. Sometimes these packages
contain a particular Windows OS version in their name, but actually work on
other OS versions too. For example, the "Windows Server 2003 SP1 Platform SDK"
also runs on Windows XP SP2 and Windows 2000.
According to the download pages the Toolkit and the .NET Framework SDK are only
supported on Windows 2000/XP/2003, so trying to use these tools on Windows
95/98/ME and even Windows NT probably won't work.
Install the Toolkit first, then the Platform SDK, then the .NET Framework SDK.
Setup your environment as follows (assuming default installation locations
were chosen):
SET PATH=%SystemRoot%\system32;%SystemRoot%;C:\Program Files\Microsoft Visual C++ Toolkit 2003\bin;C:\Program Files\Microsoft SDK\Bin;C:\Program Files\Microsoft.NET\SDK\v1.1\Bin
SET INCLUDE=C:\Program Files\Microsoft Visual C++ Toolkit 2003\include;C:\Program Files\Microsoft SDK\include;C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\include
SET LIB=C:\Program Files\Microsoft Visual C++ Toolkit 2003\lib;C:\Program Files\Microsoft SDK\lib;C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib
Several required files will still be missing:
=over 4
=item *
cvtres.exe is required by link.exe when using a .res file. It is actually
installed by the .NET Framework SDK, but into a location such as the
following:
C:\WINDOWS\Microsoft.NET\Framework\v1.1.4322
Copy it from there to C:\Program Files\Microsoft SDK\Bin
=item *
lib.exe is normally used to build libraries, but link.exe with the /lib
option also works, so change win32/config.vc to use it instead:
Change the line reading:
ar='lib'
to:
ar='link /lib'
It may also be useful to create a batch file called lib.bat in
C:\Program Files\Microsoft Visual C++ Toolkit 2003\bin containing:
@echo off
link /lib %*
for the benefit of any naughty C extension modules that you might want to build
later which explicitly reference "lib" rather than taking their value from
$Config{ar}.
=item *
setargv.obj is required to build perlglob.exe (and perl.exe if the USE_SETARGV
option is enabled). The Platform SDK supplies this object file in source form
in C:\Program Files\Microsoft SDK\src\crt. Copy setargv.c, cruntime.h and
internal.h from there to some temporary location and build setargv.obj using
cl.exe /c /I. /D_CRTBLD setargv.c
Then copy setargv.obj to C:\Program Files\Microsoft SDK\lib
Alternatively, if you don't need perlglob.exe and don't need to enable the
USE_SETARGV option then you can safely just remove all mention of $(GLOBEXE)
from win32/Makefile and setargv.obj won't be required anyway.
=back
Perl should now build using the win32/Makefile. You will need to edit that
file to set
CCTYPE = MSVC70FREE
and to set CCHOME, CCINCDIR and CCLIBDIR as per the environment setup above.
=item Microsoft Platform SDK 64-bit Compiler
The nmake that comes with the Platform SDK will suffice for building
Perl. Make sure you are building within one of the "Build Environment"
shells available after you install the Platform SDK from the Start Menu.
=item MinGW release 3 with gcc
The latest release of MinGW at the time of writing is 3.1.0, which contains
gcc-3.2.3. It can be downloaded here:
http://www.mingw.org/
Perl also compiles with earlier releases of gcc (2.95.2 and up). See below
for notes about using earlier versions of MinGW/gcc.
You also need dmake. See L</"Make"> above on how to get it.
=item MinGW release 1 with gcc
The MinGW-1.1 bundle contains gcc-2.95.3.
Make sure you install the binaries that work with MSVCRT.DLL as indicated
in the README for the GCC bundle. You may need to set up a few environment
variables (usually ran from a batch file).
There are a couple of problems with the version of gcc-2.95.2-msvcrt.exe
released 7 November 1999:
=over
=item *
It left out a fix for certain command line quotes. To fix this, be sure
to download and install the file fixes/quote-fix-msvcrt.exe from the above
ftp location.
=item *
The definition of the fpos_t type in stdio.h may be wrong. If your
stdio.h has this problem, you will see an exception when running the
test t/lib/io_xs.t. To fix this, change the typedef for fpos_t from
"long" to "long long" in the file i386-mingw32msvc/include/stdio.h,
and rebuild.
=back
A potentially simpler to install (but probably soon-to-be-outdated) bundle
of the above package with the mentioned fixes already applied is available
here:
http://downloads.ActiveState.com/pub/staff/gsar/gcc-2.95.2-msvcrt.zip
ftp://ftp.ActiveState.com/pub/staff/gsar/gcc-2.95.2-msvcrt.zip
=back
=head2 Building
=over 4
=item *
Make sure you are in the "win32" subdirectory under the perl toplevel.
This directory contains a "Makefile" that will work with
versions of nmake that come with Visual C++ or the Platform SDK, and
a dmake "makefile.mk" that will work for all supported compilers. The
defaults in the dmake makefile are setup to build using MinGW/gcc.
=item *
Edit the makefile.mk (or Makefile, if you're using nmake) and change
the values of INST_DRV and INST_TOP. You can also enable various
build flags. These are explained in the makefiles.
Note that it is generally not a good idea to try to build a perl with
INST_DRV and INST_TOP set to a path that already exists from a previous
build. In particular, this may cause problems with the
lib/ExtUtils/t/Embed.t test, which attempts to build a test program and
may end up building against the installed perl's lib/CORE directory rather
than the one being tested.
You will have to make sure that CCTYPE is set correctly and that
CCHOME points to wherever you installed your compiler.
The default value for CCHOME in the makefiles for Visual C++
may not be correct for some versions. Make sure the default exists
and is valid.
You may also need to comment out the C<DELAYLOAD = ...> line in the
Makefile if you're using VC++ 6.0 without the latest service pack and
the linker reports an internal error.
If you have either the source or a library that contains des_fcrypt(),
enable the appropriate option in the makefile. A ready-to-use version
of fcrypt.c, based on the version originally written by Eric Young at
ftp://ftp.funet.fi/pub/crypt/mirrors/dsi/libdes/, is bundled with the
distribution and CRYPT_SRC is set to use it.
Alternatively, if you have built a library that contains des_fcrypt(),
you can set CRYPT_LIB to point to the library name.
Perl will also build without des_fcrypt(), but the crypt() builtin will
fail at run time.
If you want build some core extensions statically into perl's dll, specify
them in the STATIC_EXT macro.
Be sure to read the instructions near the top of the makefiles carefully.
=item *
Type "dmake" (or "nmake" if you are using that make).
This should build everything. Specifically, it will create perl.exe,
perl58.dll at the perl toplevel, and various other extension dll's
under the lib\auto directory. If the build fails for any reason, make
sure you have done the previous steps correctly.
=back
=head2 Testing Perl on Win32
Type "dmake test" (or "nmake test"). This will run most of the tests from
the testsuite (many tests will be skipped).
There should be no test failures when running under Windows NT/2000/XP.
Many tests I<will> fail under Windows 9x due to the inferior command shell.
Some test failures may occur if you use a command shell other than the
native "cmd.exe", or if you are building from a path that contains
spaces. So don't do that.
If you are running the tests from a emacs shell window, you may see
failures in op/stat.t. Run "dmake test-notty" in that case.
If you're using the Borland compiler, you may see a failure in op/taint.t
arising from the inability to find the Borland Runtime DLLs on the system
default path. You will need to copy the DLLs reported by the messages
from where Borland chose to install it, into the Windows system directory
(usually somewhere like C:\WINNT\SYSTEM32) and rerun the test.
If you're using Borland compiler versions 5.2 and below, you may run into
problems finding the correct header files when building extensions. For
example, building the "Tk" extension may fail because both perl and Tk
contain a header file called "patchlevel.h". The latest Borland compiler
(v5.5) is free of this misbehaviour, and it even supports an
option -VI- for backward (bugward) compatibility for using the old Borland
search algorithm to locate header files.
If you run the tests on a FAT partition, you may see some failures for
C<link()> related tests:
Failed Test Stat Wstat Total Fail Failed List
../ext/IO/lib/IO/t/io_dup.t 6 4 66.67% 2-5
../lib/File/Temp/t/mktemp.t 9 1 11.11% 2
../lib/File/Temp/t/posix.t 7 1 14.29% 3
../lib/File/Temp/t/security.t 13 1 7.69% 2
../lib/File/Temp/t/tempfile.t 20 2 10.00% 2 4
comp/multiline.t 6 2 33.33% 5-6
io/dup.t 8 6 75.00% 2-7
op/write.t 47 7 14.89% 1-3 6 9-11
Testing on NTFS avoids these errors.
Furthermore, you should make sure that during C<make test> you do not
have any GNU tool packages in your path: some toolkits like Unixutils
include some tools (C<type> for instance) which override the Windows
ones and makes tests fail. Remove them from your path while testing to
avoid these errors.
Please report any other failures as described under L<BUGS AND CAVEATS>.
=head2 Installation of Perl on Win32
Type "dmake install" (or "nmake install"). This will put the newly
built perl and the libraries under whatever C<INST_TOP> points to in the
Makefile. It will also install the pod documentation under
C<$INST_TOP\$INST_VER\lib\pod> and HTML versions of the same under
C<$INST_TOP\$INST_VER\lib\pod\html>.
To use the Perl you just installed you will need to add a new entry to
your PATH environment variable: C<$INST_TOP\bin>, e.g.
set PATH=c:\perl\bin;%PATH%
If you opted to uncomment C<INST_VER> and C<INST_ARCH> in the makefile
then the installation structure is a little more complicated and you will
need to add two new PATH components instead: C<$INST_TOP\$INST_VER\bin> and
C<$INST_TOP\$INST_VER\bin\$ARCHNAME>, e.g.
set PATH=c:\perl\5.6.0\bin;c:\perl\5.6.0\bin\MSWin32-x86;%PATH%
=head2 Usage Hints for Perl on Win32
=over 4
=item Environment Variables
The installation paths that you set during the build get compiled
into perl, so you don't have to do anything additional to start
using that perl (except add its location to your PATH variable).
If you put extensions in unusual places, you can set PERL5LIB
to a list of paths separated by semicolons where you want perl
to look for libraries. Look for descriptions of other environment
variables you can set in L<perlrun>.
You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
Perl does not depend on the registry, but it can look up certain default
values if you choose to put them there. Perl attempts to read entries from
C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
Entries in the former override entries in the latter. One or more of the
following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
lib-$] version-specific standard library path to add to @INC
lib standard library path to add to @INC
sitelib-$] version-specific site library path to add to @INC
sitelib site library path to add to @INC
vendorlib-$] version-specific vendor library path to add to @INC
vendorlib vendor library path to add to @INC
PERL* fallback for all %ENV lookups that begin with "PERL"
Note the C<$]> in the above is not literal. Substitute whatever version
of perl you want to honor that entry, e.g. C<5.6.0>. Paths must be
separated with semicolons, as usual on win32.
=item File Globbing
By default, perl handles file globbing using the File::Glob extension,
which provides portable globbing.
If you want perl to use globbing that emulates the quirks of DOS
filename conventions, you might want to consider using File::DosGlob
to override the internal glob() implementation. See L<File::DosGlob> for
details.
=item Using perl from the command line
If you are accustomed to using perl from various command-line
shells found in UNIX environments, you will be less than pleased
with what Windows offers by way of a command shell.
The crucial thing to understand about the Windows environment is that
the command line you type in is processed twice before Perl sees it.
First, your command shell (usually CMD.EXE on Windows NT, and
COMMAND.COM on Windows 9x) preprocesses the command line, to handle
redirection, environment variable expansion, and location of the
executable to run. Then, the perl executable splits the remaining
command line into individual arguments, using the C runtime library
upon which Perl was built.
It is particularly important to note that neither the shell nor the C
runtime do any wildcard expansions of command-line arguments (so
wildcards need not be quoted). Also, the quoting behaviours of the
shell and the C runtime are rudimentary at best (and may, if you are
using a non-standard shell, be inconsistent). The only (useful) quote
character is the double quote ("). It can be used to protect spaces
and other special characters in arguments.
The Windows NT documentation has almost no description of how the
quoting rules are implemented, but here are some general observations
based on experiments: The C runtime breaks arguments at spaces and
passes them to programs in argc/argv. Double quotes can be used to
prevent arguments with spaces in them from being split up. You can
put a double quote in an argument by escaping it with a backslash and
enclosing the whole argument within double quotes. The backslash and
the pair of double quotes surrounding the argument will be stripped by
the C runtime.
The file redirection characters "E<lt>", "E<gt>", and "|" can be quoted by
double quotes (although there are suggestions that this may not always
be true). Single quotes are not treated as quotes by the shell or
the C runtime, they don't get stripped by the shell (just to make
this type of quoting completely useless). The caret "^" has also
been observed to behave as a quoting character, but this appears
to be a shell feature, and the caret is not stripped from the command
line, so Perl still sees it (and the C runtime phase does not treat
the caret as a quote character).
Here are some examples of usage of the "cmd" shell:
This prints two doublequotes:
perl -e "print '\"\"' "
This does the same:
perl -e "print \"\\\"\\\"\" "
This prints "bar" and writes "foo" to the file "blurch":
perl -e "print 'foo'; print STDERR 'bar'" > blurch
This prints "foo" ("bar" disappears into nowhereland):
perl -e "print 'foo'; print STDERR 'bar'" 2> nul
This prints "bar" and writes "foo" into the file "blurch":
perl -e "print 'foo'; print STDERR 'bar'" 1> blurch
This pipes "foo" to the "less" pager and prints "bar" on the console:
perl -e "print 'foo'; print STDERR 'bar'" | less
This pipes "foo\nbar\n" to the less pager:
perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less
This pipes "foo" to the pager and writes "bar" in the file "blurch":
perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less
Discovering the usefulness of the "command.com" shell on Windows 9x
is left as an exercise to the reader :)
One particularly pernicious problem with the 4NT command shell for
Windows NT is that it (nearly) always treats a % character as indicating
that environment variable expansion is needed. Under this shell, it is
therefore important to always double any % characters which you want
Perl to see (for example, for hash variables), even when they are
quoted.
=item Building Extensions
The Comprehensive Perl Archive Network (CPAN) offers a wealth
of extensions, some of which require a C compiler to build.
Look in http://www.cpan.org/ for more information on CPAN.
Note that not all of the extensions available from CPAN may work
in the Win32 environment; you should check the information at
http://testers.cpan.org/ before investing too much effort into
porting modules that don't readily build.
Most extensions (whether they require a C compiler or not) can
be built, tested and installed with the standard mantra:
perl Makefile.PL
$MAKE
$MAKE test
$MAKE install
where $MAKE is whatever 'make' program you have configured perl to
use. Use "perl -V:make" to find out what this is. Some extensions
may not provide a testsuite (so "$MAKE test" may not do anything or
fail), but most serious ones do.
It is important that you use a supported 'make' program, and
ensure Config.pm knows about it. If you don't have nmake, you can
either get dmake from the location mentioned earlier or get an
old version of nmake reportedly available from:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/nmake15.exe
Another option is to use the make written in Perl, available from
CPAN.
http://www.cpan.org/modules/by-module/Make/
You may also use dmake. See L</"Make"> above on how to get it.
Note that MakeMaker actually emits makefiles with different syntax
depending on what 'make' it thinks you are using. Therefore, it is
important that one of the following values appears in Config.pm:
make='nmake' # MakeMaker emits nmake syntax
make='dmake' # MakeMaker emits dmake syntax
any other value # MakeMaker emits generic make syntax
(e.g GNU make, or Perl make)
If the value doesn't match the 'make' program you want to use,
edit Config.pm to fix it.
If a module implements XSUBs, you will need one of the supported
C compilers. You must make sure you have set up the environment for
the compiler for command-line compilation.
If a module does not build for some reason, look carefully for
why it failed, and report problems to the module author. If
it looks like the extension building support is at fault, report
that with full details of how the build failed using the perlbug
utility.
=item Command-line Wildcard Expansion
The default command shells on DOS descendant operating systems (such
as they are) usually do not expand wildcard arguments supplied to
programs. They consider it the application's job to handle that.
This is commonly achieved by linking the application (in our case,
perl) with startup code that the C runtime libraries usually provide.
However, doing that results in incompatible perl versions (since the
behavior of the argv expansion code differs depending on the
compiler, and it is even buggy on some compilers). Besides, it may
be a source of frustration if you use such a perl binary with an
alternate shell that *does* expand wildcards.
Instead, the following solution works rather well. The nice things
about it are 1) you can start using it right away; 2) it is more
powerful, because it will do the right thing with a pattern like
*/*/*.c; 3) you can decide whether you do/don't want to use it; and
4) you can extend the method to add any customizations (or even
entirely different kinds of wildcard expansion).
C:\> copy con c:\perl\lib\Wild.pm
# Wild.pm - emulate shell @ARGV expansion on shells that don't
use File::DosGlob;
@ARGV = map {
my @g = File::DosGlob::glob($_) if /[*?]/;
@g ? @g : $_;
} @ARGV;
1;
^Z
C:\> set PERL5OPT=-MWild
C:\> perl -le "for (@ARGV) { print }" */*/perl*.c
p4view/perl/perl.c
p4view/perl/perlio.c
p4view/perl/perly.c
perl5.005/win32/perlglob.c
perl5.005/win32/perllib.c
perl5.005/win32/perlglob.c
perl5.005/win32/perllib.c
perl5.005/win32/perlglob.c
perl5.005/win32/perllib.c
Note there are two distinct steps there: 1) You'll have to create
Wild.pm and put it in your perl lib directory. 2) You'll need to
set the PERL5OPT environment variable. If you want argv expansion
to be the default, just set PERL5OPT in your default startup
environment.
If you are using the Visual C compiler, you can get the C runtime's
command line wildcard expansion built into perl binary. The resulting
binary will always expand unquoted command lines, which may not be
what you want if you use a shell that does that for you. The expansion
done is also somewhat less powerful than the approach suggested above.
=item Win32 Specific Extensions
A number of extensions specific to the Win32 platform are available
from CPAN. You may find that many of these extensions are meant to
be used under the Activeware port of Perl, which used to be the only
native port for the Win32 platform. Since the Activeware port does not
have adequate support for Perl's extension building tools, these
extensions typically do not support those tools either and, therefore,
cannot be built using the generic steps shown in the previous section.
To ensure smooth transitioning of existing code that uses the
ActiveState port, there is a bundle of Win32 extensions that contains
all of the ActiveState extensions and several other Win32 extensions from
CPAN in source form, along with many added bugfixes, and with MakeMaker
support. The latest version of this bundle is available at:
http://search.cpan.org/dist/libwin32/
See the README in that distribution for building and installation
instructions.
=item Notes on 64-bit Windows
Windows .NET Server supports the LLP64 data model on the Intel Itanium
architecture.
The LLP64 data model is different from the LP64 data model that is the
norm on 64-bit Unix platforms. In the former, C<int> and C<long> are
both 32-bit data types, while pointers are 64 bits wide. In addition,
there is a separate 64-bit wide integral type, C<__int64>. In contrast,
the LP64 data model that is pervasive on Unix platforms provides C<int>
as the 32-bit type, while both the C<long> type and pointers are of
64-bit precision. Note that both models provide for 64-bits of
addressability.
64-bit Windows running on Itanium is capable of running 32-bit x86
binaries transparently. This means that you could use a 32-bit build
of Perl on a 64-bit system. Given this, why would one want to build
a 64-bit build of Perl? Here are some reasons why you would bother:
=over
=item *
A 64-bit native application will run much more efficiently on
Itanium hardware.
=item *
There is no 2GB limit on process size.
=item *
Perl automatically provides large file support when built under
64-bit Windows.
=item *
Embedding Perl inside a 64-bit application.
=back
=back
=head2 Running Perl Scripts
Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to
indicate to the OS that it should execute the file using perl.
Win32 has no comparable means to indicate arbitrary files are
executables.
Instead, all available methods to execute plain text files on
Win32 rely on the file "extension". There are three methods
to use this to execute perl scripts:
=over 8
=item 1
There is a facility called "file extension associations" that will
work in Windows NT 4.0. This can be manipulated via the two
commands "assoc" and "ftype" that come standard with Windows NT
4.0. Type "ftype /?" for a complete example of how to set this
up for perl scripts (Say what? You thought Windows NT wasn't
perl-ready? :).
=item 2
Since file associations don't work everywhere, and there are
reportedly bugs with file associations where it does work, the
old method of wrapping the perl script to make it look like a
regular batch file to the OS, may be used. The install process
makes available the "pl2bat.bat" script which can be used to wrap
perl scripts into batch files. For example:
pl2bat foo.pl
will create the file "FOO.BAT". Note "pl2bat" strips any
.pl suffix and adds a .bat suffix to the generated file.
If you use the 4DOS/NT or similar command shell, note that
"pl2bat" uses the "%*" variable in the generated batch file to
refer to all the command line arguments, so you may need to make
sure that construct works in batch files. As of this writing,
4DOS/NT users will need a "ParameterChar = *" statement in their
4NT.INI file or will need to execute "setdos /p*" in the 4DOS/NT
startup file to enable this to work.
=item 3
Using "pl2bat" has a few problems: the file name gets changed,
so scripts that rely on C<$0> to find what they must do may not
run properly; running "pl2bat" replicates the contents of the
original script, and so this process can be maintenance intensive
if the originals get updated often. A different approach that
avoids both problems is possible.
A script called "runperl.bat" is available that can be copied
to any filename (along with the .bat suffix). For example,
if you call it "foo.bat", it will run the file "foo" when it is
executed. Since you can run batch files on Win32 platforms simply
by typing the name (without the extension), this effectively
runs the file "foo", when you type either "foo" or "foo.bat".
With this method, "foo.bat" can even be in a different location
than the file "foo", as long as "foo" is available somewhere on
the PATH. If your scripts are on a filesystem that allows symbolic
links, you can even avoid copying "runperl.bat".
Here's a diversion: copy "runperl.bat" to "runperl", and type
"runperl". Explain the observed behavior, or lack thereof. :)
Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH
=back
=head2 Miscellaneous Things
A full set of HTML documentation is installed, so you should be
able to use it if you have a web browser installed on your
system.
C<perldoc> is also a useful tool for browsing information contained
in the documentation, especially in conjunction with a pager
like C<less> (recent versions of which have Win32 support). You may
have to set the PAGER environment variable to use a specific pager.
"perldoc -f foo" will print information about the perl operator
"foo".
One common mistake when using this port with a GUI library like C<Tk>
is assuming that Perl's normal behavior of opening a command-line
window will go away. This isn't the case. If you want to start a copy
of C<perl> without opening a command-line window, use the C<wperl>
executable built during the installation process. Usage is exactly
the same as normal C<perl> on Win32, except that options like C<-h>
don't work (since they need a command-line window to print to).
If you find bugs in perl, you can run C<perlbug> to create a
bug report (you may have to send it manually if C<perlbug> cannot
find a mailer on your system).
=head1 BUGS AND CAVEATS
Norton AntiVirus interferes with the build process, particularly if
set to "AutoProtect, All Files, when Opened". Unlike large applications
the perl build process opens and modifies a lot of files. Having the
the AntiVirus scan each and every one slows build the process significantly.
Worse, with PERLIO=stdio the build process fails with peculiar messages
as the virus checker interacts badly with miniperl.exe writing configure
files (it seems to either catch file part written and treat it as suspicious,
or virus checker may have it "locked" in a way which inhibits miniperl
updating it). The build does complete with
set PERLIO=perlio
but that may be just luck. Other AntiVirus software may have similar issues.
Some of the built-in functions do not act exactly as documented in
L<perlfunc>, and a few are not implemented at all. To avoid
surprises, particularly if you have had prior exposure to Perl
in other operating environments or if you intend to write code
that will be portable to other environments, see L<perlport>
for a reasonably definitive list of these differences.
Not all extensions available from CPAN may build or work properly
in the Win32 environment. See L</"Building Extensions">.
Most C<socket()> related calls are supported, but they may not
behave as on Unix platforms. See L<perlport> for the full list.
Perl requires Winsock2 to be installed on the system. If you're
running Win95, you can download Winsock upgrade from here:
http://www.microsoft.com/windows95/downloads/contents/WUAdminTools/S_WUNetworkingTools/W95Sockets2/Default.asp
Later OS versions already include Winsock2 support.
Signal handling may not behave as on Unix platforms (where it
doesn't exactly "behave", either :). For instance, calling C<die()>
or C<exit()> from signal handlers will cause an exception, since most
implementations of C<signal()> on Win32 are severely crippled.
Thus, signals may work only for simple things like setting a flag
variable in the handler. Using signals under this port should
currently be considered unsupported.
Please send detailed descriptions of any problems and solutions that
you may find to E<lt>F<perlbug at perl.org>E<gt>, along with the output
produced by C<perl -V>.
=head1 ACKNOWLEDGEMENTS
The use of a camel with the topic of Perl is a trademark
of O'Reilly and Associates, Inc. Used with permission.
=head1 AUTHORS
=over 4
=item Gary Ng E<lt>71564.1743 at CompuServe.COME<gt>
=item Gurusamy Sarathy E<lt>gsar at activestate.comE<gt>
=item Nick Ing-Simmons E<lt>nick at ing-simmons.netE<gt>
=item Jan Dubois E<lt>jand at activestate.comE<gt>
=item Steve Hay E<lt>steve.hay at uk.radan.comE<gt>
=back
This document is maintained by Jan Dubois.
=head1 SEE ALSO
L<perl>
=head1 HISTORY
This port was originally contributed by Gary Ng around 5.003_24,
and borrowed from the Hip Communications port that was available
at the time. Various people have made numerous and sundry hacks
since then.
Borland support was added in 5.004_01 (Gurusamy Sarathy).
GCC/mingw32 support was added in 5.005 (Nick Ing-Simmons).
Support for PERL_OBJECT was added in 5.005 (ActiveState Tool Corp).
Support for fork() emulation was added in 5.6 (ActiveState Tool Corp).
Win9x support was added in 5.6 (Benjamin Stuhl).
Support for 64-bit Windows added in 5.8 (ActiveState Corp).
Last updated: 30 September 2005
=cut
--- NEW FILE: README.macos ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.macos - Perl under Mac OS (Classic)
=head1 SYNOPSIS
This document briefly describes perl under Mac OS (Classic).
If you are running perl under Mac OS X, you don't want to be
here (unless you are in the Classic environment under Mac OS X).
When we say "Mac OS" below, we mean Mac OS 7, 8, and 9, and I<not>
Mac OS X.
=head1 DESCRIPTION
The latest perl source itself builds on Mac OS, with some additional
pieces. Support for Mac OS is now in the perl core, and MacPerl is kept
in close sync with regular perl releases.
To build perl for Mac OS (as an MPW tool), you will need the addition
of the F<macos> subdirectory, distributed separately. It includes extra
source files, config files, and make files. It also includes extra
Mac-specific modules.
To build the MacPerl application, you will also need the F<macperl>
directory, which includes the source files for creating the
application itself.
All of this is available from the development site, via
HTTP (in the MacPerl Installer, which includes all the source
and binaries) and anonymous CVS.
http://dev.macperl.org/
The source is also in the main perl repository in the macperl
branch (the 5.6 source is in the maint-5.6/macperl branch).
You will also need compilers and libraries, all of them freely
available. These are linked to from the SourceForge site. Go that site
for all things having to do with MacPerl development.
MacPerl 5.6.1 and later are supported on Mac OS 8.1 and later, for 68040
and PowerPC architectures. The MPW tool may be used on Mac OS 7.5.5
and 68030 computers.
MacPerl 5.2.0r4 is also available, on the CPAN and on SourceForge. It
is based on perl 5.004, and works with Mac OS 7.5.5 and 68030 computers.
=head1 AUTHOR
perl was ported to Mac OS by Matthias Neeracher
E<lt>neeracher at mac.comE<gt>. It is currently maintained by Chris
Nandor E<lt>pudge at pobox.comE<gt>.
=head1 DATE
Last modified 2002.05.02.
--- NEW FILE: fakethr.h ---
/* fakethr.h
*
* Copyright (C) 1999, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
typedef int perl_mutex;
typedef int perl_key;
typedef struct perl_thread *perl_os_thread;
/* With fake threads, thr is global(ish) so we don't need dTHR */
#define dTHR extern int errno
struct perl_wait_queue {
struct perl_thread * thread;
struct perl_wait_queue * next;
};
typedef struct perl_wait_queue *perl_cond;
/* Ask thread.h to include our per-thread extras */
#define HAVE_THREAD_INTERN
struct thread_intern {
perl_os_thread next_run, prev_run; /* Linked list of runnable threads */
perl_cond wait_queue; /* Wait queue that we are waiting on */
IV private; /* Holds data across time slices */
I32 savemark; /* Holds MARK for thread join values */
};
#define init_thread_intern(t) \
STMT_START { \
t->self = (t); \
(t)->i.next_run = (t)->i.prev_run = (t); \
(t)->i.wait_queue = 0; \
(t)->i.private = 0; \
} STMT_END
/*
* Note that SCHEDULE() is only callable from pp code (which
* must be expecting to be restarted). We'll have to do
* something a bit different for XS code.
*/
#define SCHEDULE() return schedule(), PL_op
#define MUTEX_LOCK(m)
#define MUTEX_UNLOCK(m)
#define MUTEX_INIT(m)
#define MUTEX_DESTROY(m)
#define COND_INIT(c) perl_cond_init(c)
#define COND_SIGNAL(c) perl_cond_signal(c)
#define COND_BROADCAST(c) perl_cond_broadcast(c)
#define COND_WAIT(c, m) \
STMT_START { \
perl_cond_wait(c); \
SCHEDULE(); \
} STMT_END
#define COND_DESTROY(c)
#define THREAD_CREATE(t, f) f((t))
#define THREAD_POST_CREATE(t) NOOP
#define YIELD NOOP
--- NEW FILE: form.h ---
/* form.h
*
* Copyright (C) 1991, 1992, 1993, 2000, 2004 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#define FF_END 0
#define FF_LINEMARK 1
#define FF_LITERAL 2
#define FF_SKIP 3
#define FF_FETCH 4
#define FF_CHECKNL 5
#define FF_CHECKCHOP 6
#define FF_SPACE 7
#define FF_HALFSPACE 8
#define FF_ITEM 9
#define FF_CHOP 10
#define FF_LINEGLOB 11
#define FF_DECIMAL 12
#define FF_NEWLINE 13
#define FF_BLANK 14
#define FF_MORE 15
#define FF_0DECIMAL 16
#define FF_LINESNGL 17
--- NEW FILE: regen.pl ---
#!/usr/bin/perl -w
require 5.003; # keep this compatible, an old perl is all we may have before
# we build the new one
# The idea is to move the regen_headers target out of the Makefile so that
# it is possible to rebuild the headers before the Makefile is available.
# (and the Makefile is unavailable until after Configure is run, and we may
# wish to make a clean source tree but with current headers without running
# anything else.
use strict;
my $perl = $^X;
require 'regen_lib.pl';
# keep warnings.pl in sync with the CPAN distribution by not requiring core
# changes
safer_unlink ("warnings.h", "lib/warnings.pm");
my %gen = (
'autodoc.pl' => [qw[pod/perlapi.pod pod/perlintern.pod]],
'bytecode.pl' => [qw[ext/ByteLoader/byterun.h
ext/ByteLoader/byterun.c
ext/B/B/Asmdata.pm]],
'embed.pl' => [qw[proto.h embed.h embedvar.h global.sym
perlapi.h perlapi.c]],
'keywords.pl' => [qw[keywords.h]],
'opcode.pl' => [qw[opcode.h opnames.h pp_proto.h pp.sym]],
'regcomp.pl' => [qw[regnodes.h]],
'warnings.pl' => [qw[warnings.h lib/warnings.pm]],
'reentr.pl' => [qw[reentr.c reentr.h]],
);
sub do_cksum {
my $pl = shift;
my %cksum;
for my $f (@{ $gen{$pl} }) {
local *FH;
if (open(FH, $f)) {
local $/;
$cksum{$f} = unpack("%32C*", <FH>);
close FH;
} else {
warn "$0: $f: $!\n";
}
}
return %cksum;
}
foreach my $pl (qw (keywords.pl opcode.pl embed.pl bytecode.pl
regcomp.pl warnings.pl autodoc.pl reentr.pl)) {
print "$^X $pl\n";
my %cksum0;
%cksum0 = do_cksum($pl) unless $pl eq 'warnings.pl'; # the files were removed
system "$^X $pl";
next if $pl eq 'warnings.pl'; # the files were removed
my %cksum1 = do_cksum($pl);
my @chg;
for my $f (@{ $gen{$pl} }) {
push(@chg, $f)
if !defined($cksum0{$f}) ||
!defined($cksum1{$f}) ||
$cksum0{$f} ne $cksum1{$f};
}
print "Changed: @chg\n" if @chg;
}
--- NEW FILE: doop.c ---
/* doop.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "'So that was the job I felt I had to do when I started,' thought Sam."
*/
/* This file contains some common functions needed to carry out certain
* ops. For example both pp_schomp() and pp_chomp() - scalar and array
* chomp operations - call the function do_chomp() found in this file.
*/
[...1392 lines suppressed...]
(unsigned long)HeHASH(entry),
(int)HvMAX(keys)+1,
(unsigned long)(HeHASH(entry) & HvMAX(keys))));
SPAGAIN;
XPUSHs(tmpstr);
}
PUTBACK;
}
return NORMAL;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perliol.h ---
#ifndef _PERLIOL_H
#define _PERLIOL_H
typedef struct {
PerlIO_funcs *funcs;
SV *arg;
} PerlIO_pair_t;
struct PerlIO_list_s {
IV refcnt;
IV cur;
IV len;
PerlIO_pair_t *array;
};
struct _PerlIO_funcs {
Size_t fsize;
const char *name;
Size_t size;
U32 kind;
IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
IV (*Popped) (pTHX_ PerlIO *f);
PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab,
PerlIO_list_t *layers, IV n,
const char *mode,
int fd, int imode, int perm,
PerlIO *old, int narg, SV **args);
IV (*Binmode)(pTHX_ PerlIO *f);
SV *(*Getarg) (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags);
IV (*Fileno) (pTHX_ PerlIO *f);
PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
/* Unix-like functions - cf sfio line disciplines */
SSize_t(*Read) (pTHX_ PerlIO *f, void *vbuf, Size_t count);
SSize_t(*Unread) (pTHX_ PerlIO *f, const void *vbuf, Size_t count);
SSize_t(*Write) (pTHX_ PerlIO *f, const void *vbuf, Size_t count);
IV (*Seek) (pTHX_ PerlIO *f, Off_t offset, int whence);
Off_t(*Tell) (pTHX_ PerlIO *f);
IV (*Close) (pTHX_ PerlIO *f);
/* Stdio-like buffered IO functions */
IV (*Flush) (pTHX_ PerlIO *f);
IV (*Fill) (pTHX_ PerlIO *f);
IV (*Eof) (pTHX_ PerlIO *f);
IV (*Error) (pTHX_ PerlIO *f);
void (*Clearerr) (pTHX_ PerlIO *f);
void (*Setlinebuf) (pTHX_ PerlIO *f);
/* Perl's snooping functions */
STDCHAR *(*Get_base) (pTHX_ PerlIO *f);
Size_t(*Get_bufsiz) (pTHX_ PerlIO *f);
STDCHAR *(*Get_ptr) (pTHX_ PerlIO *f);
SSize_t(*Get_cnt) (pTHX_ PerlIO *f);
void (*Set_ptrcnt) (pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
};
/*--------------------------------------------------------------------------------------*/
/* Kind values */
#define PERLIO_K_RAW 0x00000001
#define PERLIO_K_BUFFERED 0x00000002
#define PERLIO_K_CANCRLF 0x00000004
#define PERLIO_K_FASTGETS 0x00000008
#define PERLIO_K_DUMMY 0x00000010
#define PERLIO_K_UTF8 0x00008000
#define PERLIO_K_DESTRUCT 0x00010000
#define PERLIO_K_MULTIARG 0x00020000
/*--------------------------------------------------------------------------------------*/
struct _PerlIO {
PerlIOl *next; /* Lower layer */
PerlIO_funcs *tab; /* Functions for this layer */
U32 flags; /* Various flags for state */
};
/*--------------------------------------------------------------------------------------*/
/* Flag values */
#define PERLIO_F_EOF 0x00000100
#define PERLIO_F_CANWRITE 0x00000200
#define PERLIO_F_CANREAD 0x00000400
#define PERLIO_F_ERROR 0x00000800
#define PERLIO_F_TRUNCATE 0x00001000
#define PERLIO_F_APPEND 0x00002000
#define PERLIO_F_CRLF 0x00004000
#define PERLIO_F_UTF8 0x00008000
#define PERLIO_F_UNBUF 0x00010000
#define PERLIO_F_WRBUF 0x00020000
#define PERLIO_F_RDBUF 0x00040000
#define PERLIO_F_LINEBUF 0x00080000
#define PERLIO_F_TEMP 0x00100000
#define PERLIO_F_OPEN 0x00200000
#define PERLIO_F_FASTGETS 0x00400000
#define PERLIO_F_TTY 0x00800000
#define PERLIO_F_NOTREG 0x01000000
#define PerlIOBase(f) (*(f))
#define PerlIOSelf(f,type) ((type *)PerlIOBase(f))
#define PerlIONext(f) (&(PerlIOBase(f)->next))
#define PerlIOValid(f) ((f) && *(f))
/*--------------------------------------------------------------------------------------*/
/* Data exports - EXTCONST rather than extern is needed for Cygwin */
#undef EXTPERLIO
#ifdef PERLIO_FUNCS_CONST
#define EXTPERLIO EXTCONST
#else
#define EXTPERLIO EXT
#endif
EXTPERLIO PerlIO_funcs PerlIO_unix;
EXTPERLIO PerlIO_funcs PerlIO_perlio;
EXTPERLIO PerlIO_funcs PerlIO_stdio;
EXTPERLIO PerlIO_funcs PerlIO_crlf;
EXTPERLIO PerlIO_funcs PerlIO_utf8;
EXTPERLIO PerlIO_funcs PerlIO_byte;
EXTPERLIO PerlIO_funcs PerlIO_raw;
EXTPERLIO PerlIO_funcs PerlIO_pending;
#ifdef HAS_MMAP
EXTPERLIO PerlIO_funcs PerlIO_mmap;
#endif
#ifdef WIN32
EXTPERLIO PerlIO_funcs PerlIO_win32;
#endif
PERL_EXPORT_C PerlIO *PerlIO_allocate(pTHX);
PERL_EXPORT_C SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n);
#define PerlIOArg PerlIO_arg_fetch(layers,n)
#ifdef PERLIO_USING_CRLF
#define PERLIO_STDTEXT "t"
#else
#define PERLIO_STDTEXT ""
#endif
/*--------------------------------------------------------------------------------------*/
/* perlio buffer layer
As this is reasonably generic its struct and "methods" are declared here
so they can be used to "inherit" from it.
*/
typedef struct {
struct _PerlIO base; /* Base "class" info */
STDCHAR *buf; /* Start of buffer */
STDCHAR *end; /* End of valid part of buffer */
STDCHAR *ptr; /* Current position in buffer */
Off_t posn; /* Offset of buf into the file */
Size_t bufsiz; /* Real size of buffer */
IV oneword; /* Emergency buffer */
} PerlIOBuf;
PERL_EXPORT_C int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode,
PerlIO_list_t *layers, IV n, IV max);
PERL_EXPORT_C int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names);
PERL_EXPORT_C PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def);
PERL_EXPORT_C SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
PERL_EXPORT_C void PerlIO_cleantable(pTHX_ PerlIO **tablep);
PERL_EXPORT_C SV * PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab);
PERL_EXPORT_C void PerlIO_default_buffer(pTHX_ PerlIO_list_t *av);
PERL_EXPORT_C void PerlIO_stdstreams(pTHX);
PERL_EXPORT_C int PerlIO__close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO_list_t * PerlIO_resolve_layers(pTHX_ const char *layers, const char *mode, int narg, SV **args);
PERL_EXPORT_C PerlIO_funcs * PerlIO_default_layer(pTHX_ I32 n);
PERL_EXPORT_C PerlIO_list_t * PerlIO_default_layers(pTHX);
PERL_EXPORT_C PerlIO * PerlIO_reopen(const char *path, const char *mode, PerlIO *f);
PERL_EXPORT_C int PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
__attribute__format__(__printf__,3,0);
PERL_EXPORT_C PerlIO_list_t *PerlIO_list_alloc(pTHX);
PERL_EXPORT_C PerlIO_list_t *PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param);
PERL_EXPORT_C void PerlIO_list_free(pTHX_ PerlIO_list_t *list);
PERL_EXPORT_C void PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg);
PERL_EXPORT_C void PerlIO_list_free(pTHX_ PerlIO_list_t *list);
/*--------------------------------------------------------------------------------------*/
/* Generic, or stub layer functions */
PERL_EXPORT_C IV PerlIOBase_binmode(pTHX_ PerlIO *f);
PERL_EXPORT_C void PerlIOBase_clearerr(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
PERL_EXPORT_C IV PerlIOBase_eof(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_error(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_fileno(pTHX_ PerlIO *f);
PERL_EXPORT_C void PerlIOBase_flush_linebuf(pTHX);
PERL_EXPORT_C IV PerlIOBase_noop_fail(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_noop_ok(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_popped(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C SSize_t PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PERL_EXPORT_C void PerlIOBase_setlinebuf(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Buf */
PERL_EXPORT_C Size_t PerlIOBuf_bufsiz(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBuf_close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
PERL_EXPORT_C IV PerlIOBuf_fill(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBuf_flush(pTHX_ PerlIO *f);
PERL_EXPORT_C STDCHAR * PerlIOBuf_get_base(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOBuf_get_cnt(pTHX_ PerlIO *f);
PERL_EXPORT_C STDCHAR * PerlIOBuf_get_ptr(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args);
PERL_EXPORT_C IV PerlIOBuf_popped(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PERL_EXPORT_C IV PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
PERL_EXPORT_C void PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
PERL_EXPORT_C Off_t PerlIOBuf_tell(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
PERL_EXPORT_C SSize_t PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Crlf */
PERL_EXPORT_C IV PerlIOCrlf_binmode(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOCrlf_flush(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOCrlf_get_cnt(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C void PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
PERL_EXPORT_C SSize_t PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
PERL_EXPORT_C SSize_t PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
PERL_EXPORT_C SSize_t PerlIOCrlf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Mmap */
PERL_EXPORT_C IV PerlIOMmap_close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
PERL_EXPORT_C IV PerlIOMmap_fill(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOMmap_flush(pTHX_ PerlIO *f);
PERL_EXPORT_C STDCHAR * PerlIOMmap_get_base(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOMmap_map(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOMmap_unmap(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
PERL_EXPORT_C SSize_t PerlIOMmap_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Pending */
PERL_EXPORT_C IV PerlIOPending_close(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOPending_fill(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOPending_flush(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C SSize_t PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PERL_EXPORT_C IV PerlIOPending_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
PERL_EXPORT_C void PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
/* Pop */
PERL_EXPORT_C IV PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
/* Raw */
PERL_EXPORT_C PerlIO * PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args);
PERL_EXPORT_C IV PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
/* Stdio */
PERL_EXPORT_C void PerlIOStdio_clearerr(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOStdio_close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
PERL_EXPORT_C IV PerlIOStdio_eof(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOStdio_error(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOStdio_fileno(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOStdio_fill(pTHX_ PerlIO *f);
PERL_EXPORT_C IV PerlIOStdio_flush(pTHX_ PerlIO *f);
PERL_EXPORT_C STDCHAR * PerlIOStdio_get_base(pTHX_ PerlIO *f);
PERL_EXPORT_C char * PerlIOStdio_mode(const char *mode, char *tmode);
PERL_EXPORT_C PerlIO * PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args);
PERL_EXPORT_C IV PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C SSize_t PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PERL_EXPORT_C IV PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
PERL_EXPORT_C void PerlIOStdio_setlinebuf(pTHX_ PerlIO *f);
PERL_EXPORT_C Off_t PerlIOStdio_tell(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
PERL_EXPORT_C SSize_t PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Unix */
PERL_EXPORT_C IV PerlIOUnix_close(pTHX_ PerlIO *f);
PERL_EXPORT_C PerlIO * PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
PERL_EXPORT_C IV PerlIOUnix_fileno(pTHX_ PerlIO *f);
PERL_EXPORT_C int PerlIOUnix_oflags(const char *mode);
PERL_EXPORT_C PerlIO * PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args);
PERL_EXPORT_C IV PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
PERL_EXPORT_C SSize_t PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PERL_EXPORT_C int PerlIOUnix_refcnt_dec(int fd);
PERL_EXPORT_C void PerlIOUnix_refcnt_inc(int fd);
PERL_EXPORT_C IV PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
PERL_EXPORT_C Off_t PerlIOUnix_tell(pTHX_ PerlIO *f);
PERL_EXPORT_C SSize_t PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
/* Utf8 */
PERL_EXPORT_C IV PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
#endif /* _PERLIOL_H */
--- NEW FILE: perl.h ---
/* perl.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifndef H_PERL
#define H_PERL 1
#ifdef PERL_FOR_X2P
/*
* This file is being used for x2p stuff.
* Above symbol is defined via -D in 'x2p/Makefile.SH'
* Decouple x2p stuff from some of perls more extreme eccentricities.
*/
[...4875 lines suppressed...]
HAS_STRUCT_MSGHDR
HAS_STRUCT_CMSGHDR
HAS_NL_LANGINFO
HAS_DIRFD
so that Configure picks them up. */
/* Source code compatibility cruft:
PERL_XS_APIVERSION is not used, and has been superseded by inc_version_list
It and PERL_PM_APIVERSION are retained for source compatibility in the
5.8.x maintenance branch.
*/
#define PERL_XS_APIVERSION "5.8.3"
#define PERL_PM_APIVERSION "5.005"
#endif /* Include guard */
--- NEW FILE: perl.c ---
/* perl.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "A ship then new they built for him/of mithril and of elven glass" --Bilbo
*/
/* This file contains the top-level functions that are used to create, use
* and destroy a perl interpreter, plus the functions used by XS code to
* call back into perl. Note that it does not contain the actual main()
* function of the interpreter; that can be found in perlmain.c
*/
[...5265 lines suppressed...]
nl = (nl) ? nl+1 : SvEND(PL_e_script);
if (nl-p == 0) {
filter_del(read_e_script);
return 0;
}
sv_catpvn(buf_sv, p, nl-p);
sv_chop(PL_e_script, (char *) nl);
return 1;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.qnx ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.qnx - Perl version 5 on QNX
=head1 DESCRIPTION
As of perl5.7.2 all tests pass under:
QNX 4.24G
Watcom 10.6 with Beta/970211.wcc.update.tar.F
socket3r.lib Nov21 1996.
As of perl5.8.1 there is at least one test still failing.
Some tests may complain under known circumstances.
See below and hints/qnx.sh for more information.
Under QNX 6.2.0 there are still a few tests which fail.
See below and hints/qnx.sh for more information.
=head2 Required Software for Compiling Perl on QNX4
As with many unix ports, this one depends on a few "standard"
unix utilities which are not necessarily standard for QNX4.
=over 4
=item /bin/sh
This is used heavily by Configure and then by
perl itself. QNX4's version is fine, but Configure
will choke on the 16-bit version, so if you are
running QNX 4.22, link /bin/sh to /bin32/ksh
=item ar
This is the standard unix library builder.
We use wlib. With Watcom 10.6, when wlib is
linked as "ar", it behaves like ar and all is
fine. Under 9.5, a cover is required. One is
included in ../qnx
=item nm
This is used (optionally) by configure to list
the contents of libraries. I will generate
a cover function on the fly in the UU directory.
=item cpp
Configure and perl need a way to invoke a C
preprocessor. I have created a simple cover
for cc which does the right thing. Without this,
Configure will create its own wrapper which works,
but it doesn't handle some of the command line arguments
that perl will throw at it.
=item make
You really need GNU make to compile this. GNU make
ships by default with QNX 4.23, but you can get it
from quics for earlier versions.
=back
=head2 Outstanding Issues with Perl on QNX4
There is no support for dynamically linked libraries in QNX4.
If you wish to compile with the Socket extension, you need
to have the TCP/IP toolkit, and you need to make sure that
-lsocket locates the correct copy of socket3r.lib. Beware
that the Watcom compiler ships with a stub version of
socket3r.lib which has very little functionality. Also
beware the order in which wlink searches directories for
libraries. You may have /usr/lib/socket3r.lib pointing to
the correct library, but wlink may pick up
/usr/watcom/10.6/usr/lib/socket3r.lib instead. Make sure
they both point to the correct library, that is,
/usr/tcptk/current/usr/lib/socket3r.lib.
The following tests may report errors under QNX4:
ext/Cwd/Cwd.t will complain if `pwd` and cwd don't give
the same results. cwd calls `fullpath -t`, so if you
cd `fullpath -t` before running the test, it will
pass.
lib/File/Find/taint.t will complain if '.' is in your
PATH. The PATH test is triggered because cwd calls
`fullpath -t`.
ext/IO/lib/IO/t/io_sock.t: Subtests 14 and 22 are skipped due to
the fact that the functionality to read back the non-blocking
status of a socket is not implemented in QNX's TCP/IP. This has
been reported to QNX and it may work with later versions of
TCP/IP.
t/io/tell.t: Subtest 27 is failing. We are still investigating.
=head2 QNX auxiliary files
The files in the "qnx" directory are:
=over 4
=item qnx/ar
A script that emulates the standard unix archive (aka library)
utility. Under Watcom 10.6, ar is linked to wlib and provides the
expected interface. With Watcom 9.5, a cover function is
required. This one is fairly crude but has proved adequate for
compiling perl.
=item qnx/cpp
A script that provides C preprocessing functionality. Configure can
generate a similar cover, but it doesn't handle all the command-line
options that perl throws at it. This might be reasonably placed in
/usr/local/bin.
=back
=head2 Outstanding issues with perl under QNX6
The following tests are still failing for Perl 5.8.1 under QNX 6.2.0:
op/sprintf.........................FAILED at test 91
lib/Benchmark......................FAILED at test 26
This is due to a bug in the C library's printf routine.
printf("'%e'", 0. ) produces '0.000000e+0', but ANSI requires
'0.000000e+00'. QNX has acknowledged the bug.
=head1 AUTHOR
Norton T. Allen (allen at huarp.harvard.edu)
--- NEW FILE: perlio.sym ---
# Symbols which arise as part of the PerlIO abstraction
PerlIO_canset_cnt
PerlIO_exportFILE
PerlIO_fast_gets
PerlIO_fdopen
PerlIO_findFILE
PerlIO_getc
PerlIO_getname
PerlIO_getpos
PerlIO_has_base
PerlIO_has_cntptr
PerlIO_importFILE
PerlIO_init
PerlIO_modestr
PerlIO_open
PerlIO_printf
PerlIO_putc
PerlIO_puts
PerlIO_releaseFILE
PerlIO_reopen
PerlIO_rewind
PerlIO_setpos
PerlIO_sprintf
PerlIO_stdoutf
PerlIO_tmpfile
PerlIO_ungetc
PerlIO_vprintf
PerlIO_vsprintf
--- NEW FILE: META.yml ---
name: perl
version: 5.008008
abstract: Practical Extraction and Reporting Language
author: perl5-porters at perl.org
license: perl
distribution_type: core
private:
directory:
- ext/Cwd
- ext/Data/Dumper
- ext/DB_File
- ext/Devel/PPPort
- ext/Digest/MD5
- ext/Encode
- ext/Filter/Util/Call
- ext/IO
- ext/List/Util
- ext/MIME/Base64
- ext/Safe
- ext/Storable
- ext/Time/HiRes
- ext/Unicode/Normalize
- lib/Attribute/Handlers
- lib/base
- lib/bignum
- lib/CGI
- lib/Class/ISA
- lib/CPAN
- lib/Digest
- lib/ExtUtils/t
- lib/File/Spec
- lib/File/Temp
- lib/Filter/Simple
- lib/Getopt/Long
- lib/I18N/LangTags
- lib/Locale/Maketext
- lib/Math/BigFloat
- lib/Math/BigInt
- lib/Math/BigRat
- lib/Memoize
- lib/Net/FTP
- lib/Net/Ping
- lib/Net/t
- lib/NEXT
- lib/Pod/Perldoc
- lib/Switch
- lib/Term/ANSIColor
- lib/Test/Harness
- lib/Test/Simple
- lib/Test/t
- lib/Text/Balanced
- lib/Text/TabsWrap
- lib/Tie/File
- lib/Unicode/Collate
- t/lib/Filter/Simple
- t/lib/MakeMaker
- t/lib/Math
- t/lib/sample-tests
- t/lib/Test/Simple
file:
- ext/Compress/Zlib
- ext/DynaLoader/t/XSLoader.t
- ext/DynaLoader/XSLoader_pm.PL
- ext/Filter/t/call.t
- ext/Math/BigInt/FastCalc
- lib/Archive/Tar
- lib/Archive/Tar.pm
- lib/Attribute/Handlers.pm
- lib/base.pm
- lib/bigint.pm
- lib/bignum.pm
- lib/bigrat.pm
- lib/CGI.pm
- lib/Class/ISA.pm
- lib/CPAN.pm
- lib/Cwd.pm
- lib/Digest.pm
- lib/encoding/warnings
- lib/encoding/warnings.pm
- lib/ExtUtils/CBuilder
- lib/ExtUtils/CBuilder.pm
- lib/ExtUtils/Command
- lib/ExtUtils/Command.pm
- lib/ExtUtils/Install.pm
- lib/ExtUtils/Installed.pm
- lib/ExtUtils/Liblist
- lib/ExtUtils/Liblist.pm
- lib/ExtUtils/MakeMaker
- lib/ExtUtils/MakeMaker.pm
- lib/ExtUtils/Manifest.pm
- lib/ExtUtils/MANIFEST.SKIP
- lib/ExtUtils/Mkbootstrap.pm
- lib/ExtUtils/Mksymlists.pm
- lib/ExtUtils/MM.pm
- lib/ExtUtils/MM_AIX.pm
- lib/ExtUtils/MM_Any.pm
- lib/ExtUtils/MM_BeOS.pm
- lib/ExtUtils/MM_Cygwin.pm
- lib/ExtUtils/MM_DOS.pm
- lib/ExtUtils/MM_MacOS.pm
- lib/ExtUtils/MM_NW5.pm
- lib/ExtUtils/MM_OS2.pm
- lib/ExtUtils/MM_QNX.pm
- lib/ExtUtils/MM_Unix.pm
- lib/ExtUtils/MM_UWIN.pm
- lib/ExtUtils/MM_VMS.pm
- lib/ExtUtils/MM_VOS.pm
- lib/ExtUtils/MM_Win32.pm
- lib/ExtUtils/MM_Win95.pm
- lib/ExtUtils/MY.pm
- lib/ExtUtils/Packlist.pm
- lib/ExtUtils/ParseXS
- lib/ExtUtils/ParseXS.pm
- lib/ExtUtils/testlib.pm
- lib/fields.pm
- lib/File/Spec.pm
- lib/File/Temp.pm
- lib/Filter/Simple.pm
- lib/Getopt/Long.pm
- lib/I18N/LangTags.pm
- lib/if.pm
- lib/if.t
- lib/IO/Zlib
- lib/IO/Zlib.pm
- lib/Locale/Codes
- lib/Locale/Constants.pm
- lib/Locale/Constants.pod
- lib/Locale/Country.pm
- lib/Locale/Country.pod
- lib/Locale/Currency.pm
- lib/Locale/Currency.pod
- lib/Locale/Language.pm
- lib/Locale/Language.pod
- lib/Locale/Maketext.pm
- lib/Locale/Script.pm
- lib/Locale/Script.pod
- lib/Math/BigFloat.pm
- lib/Math/BigInt.pm
- lib/Math/BigRat.pm
- lib/Memoize.pm
- lib/Module/CoreList
- lib/Module/CoreList.pm
- lib/Net/ChangeLog.libnet
- lib/Net/Cmd.pm
- lib/Net/Config.eg
- lib/Net/Config.pm
- lib/Net/Domain.pm
- lib/Net/FTP.pm
- lib/Net/Hostname.eg
- lib/Net/libnetFAQ.pod
- lib/Net/Netrc.pm
- lib/Net/NNTP.pm
- lib/Net/Ping.pm
- lib/Net/POP3.pm
- lib/Net/README.libnet
- lib/Net/SMTP.pm
- lib/Net/Time.pm
- lib/NEXT.pm
- lib/PerlIO/via/QuotedPrint.pm
- lib/PerlIO/via/t/QuotedPrint.t
- lib/Pod/Checker.pm
- lib/Pod/Escapes
- lib/Pod/Escapes.pm
- lib/Pod/Find.pm
- lib/Pod/InputObjects.pm
- lib/Pod/LaTeX.pm
- lib/Pod/Man.pm
- lib/Pod/ParseLink.pm
- lib/Pod/Parser.pm
- lib/Pod/ParseUtils.pm
- lib/Pod/Perldoc.pm
- lib/Pod/PlainText.pm
- lib/Pod/Select.pm
- lib/Pod/Simple
- lib/Pod/Simple.pm
- lib/Pod/Simple.pod
- lib/Pod/t/basic.cap
- lib/Pod/t/basic.clr
- lib/Pod/t/basic.man
- lib/Pod/t/basic.ovr
- lib/Pod/t/basic.pod
- lib/Pod/t/basic.t
- lib/Pod/t/basic.txt
- lib/Pod/t/man.t
- lib/Pod/t/parselink.t
- lib/Pod/t/pod2latex.t
- lib/Pod/t/text-errors.t
- lib/Pod/t/text-options.t
- lib/Pod/t/text.t
- lib/Pod/Text.pm
- lib/Pod/Text/Color.pm
- lib/Pod/Text/Overstrike.pm
- lib/Pod/Text/Termcap.pm
- lib/Pod/Usage.pm
- lib/Switch.pm
- lib/Term/ANSIColor.pm
- lib/Term/Cap.pm
- lib/Term/Cap.t
- lib/Test.pm
- lib/Test/Builder.pm
- lib/Test/Harness.pm
- lib/Test/More.pm
- lib/Test/Simple.pm
- lib/Text/Balanced.pm
- lib/Text/Tabs.pm
- lib/Text/Wrap.pm
- lib/Tie/File.pm
- lib/Time/Local.pm
- lib/Time/Local.t
- lib/Unicode/Collate.pm
- pod/pod2man.PL
- pod/pod2text.PL
- pod/pod2usage.PL
- pod/podchecker.PL
- pod/podselect.PL
- t/lib/filter-util.pl
- t/lib/TieIn.pm
- t/lib/TieOut.pm
- t/lib/ZlibTestUtils.pm
- t/pod/emptycmd.t
- t/pod/emptycmd.xr
- t/pod/find.t
- t/pod/for.t
- t/pod/for.xr
- t/pod/headings.t
- t/pod/headings.xr
- t/pod/include.t
- t/pod/include.xr
- t/pod/included.t
- t/pod/included.xr
- t/pod/lref.t
- t/pod/lref.xr
- t/pod/multiline_items.t
- t/pod/multiline_items.xr
- t/pod/nested_items.t
- t/pod/nested_items.xr
- t/pod/nested_seqs.t
- t/pod/nested_seqs.xr
- t/pod/oneline_cmds.t
- t/pod/oneline_cmds.xr
- t/pod/pod2usage.t
- t/pod/pod2usage.xr
- t/pod/poderrs.t
- t/pod/poderrs.xr
- t/pod/podselect.t
- t/pod/podselect.xr
- t/pod/special_seqs.t
- t/pod/special_seqs.xr
- t/pod/testcmp.pl
- t/pod/testp2pt.pl
- t/pod/testpchk.pl
--- NEW FILE: perly.y ---
/* perly.y
*
* Copyright (c) 1991-2002, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* 'I see,' laughed Strider. 'I look foul and feel fair. Is that it?
* All that is gold does not glitter, not all those who wander are lost.'
*/
/* This file holds the grammar for the Perl language. If edited, you need
* to run regen_perly.pl, which re-creates the files perly.h, perly.tab
* and perly.act which are derived from this.
*
* The main job of of this grammar is to call the various newFOO()
* functions in op.c to build a syntax tree of OP structs.
* It relies on the lexer in toke.c to do the tokenizing.
*/
%{
#include "EXTERN.h"
#define PERL_IN_PERLY_C
#include "perl.h"
#ifdef EBCDIC
#undef YYDEBUG
#endif
#define dep() deprecate("\"do\" to call subroutines")
/* stuff included here to make perly_c.diff apply better */
#define yydebug PL_yydebug
#define yynerrs PL_yynerrs
#define yyerrflag PL_yyerrflag
#define yychar PL_yychar
#define yyval PL_yyval
#define yylval PL_yylval
struct ysv {
short* yyss;
YYSTYPE* yyvs;
int oldyydebug;
int oldyynerrs;
int oldyyerrflag;
int oldyychar;
YYSTYPE oldyyval;
YYSTYPE oldyylval;
};
static void yydestruct(pTHX_ void *ptr);
%}
%start prog
%{
#if 0 /* get this from perly.h instead */
%}
%union {
I32 ival;
char *pval;
OP *opval;
GV *gvval;
}
%{
#endif /* 0 */
#ifdef USE_PURE_BISON
#define YYLEX_PARAM (&yychar)
#define yylex yylex_r
#endif
%}
%token <ival> '{'
%token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
%token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
%token <pval> LABEL
%token <ival> FORMAT SUB ANONSUB PACKAGE USE
%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
%token <ival> LOOPEX DOTDOT
%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
%token <ival> RELOP EQOP MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
%token <ival> LOCAL MY MYSUB
%token COLONATTR
%type <ival> prog decl format startsub startanonsub startformsub
%type <ival> progstart remember mremember '&'
%type <opval> block mblock lineseq line loop cond else
%type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
%type <opval> listexpr listexprcom indirob listop method
%type <opval> formname subname proto subbody cont my_scalar
%type <opval> subattrlist myattrlist mysubrout myattrterm myterm
%type <opval> termbinop termunop anonymous termdo
%type <pval> label
%nonassoc PREC_LOW
%nonassoc LOOPEX
%left <ival> OROP
%left ANDOP
%right NOTOP
%nonassoc LSTOP LSTOPSUB
%left ','
%right <ival> ASSIGNOP
%right '?' ':'
%nonassoc DOTDOT
%left OROR
%left ANDAND
%left <ival> BITOROP
%left <ival> BITANDOP
%nonassoc EQOP
%nonassoc RELOP
%nonassoc UNIOP UNIOPSUB
%left <ival> SHIFTOP
%left ADDOP
%left MULOP
%left <ival> MATCHOP
%right '!' '~' UMINUS REFGEN
%right <ival> POWOP
%nonassoc PREINC PREDEC POSTINC POSTDEC
%left ARROW
%nonassoc <ival> ')'
%left '('
%left '[' '{'
%% /* RULES */
/* The whole program */
prog : progstart
/*CONTINUED*/ lineseq
{ $$ = $1; newPROG(block_end($1,$2)); }
;
/* An ordinary block */
block : '{' remember lineseq '}'
{ if (PL_copline > (line_t)$1)
PL_copline = (line_t)$1;
$$ = block_end($2, $3); }
;
remember: /* NULL */ /* start a full lexical scope */
{ $$ = block_start(TRUE); }
;
progstart:
{
#if defined(YYDEBUG) && defined(DEBUGGING)
yydebug = (DEBUG_p_TEST);
#endif
PL_expect = XSTATE; $$ = block_start(TRUE);
}
;
mblock : '{' mremember lineseq '}'
{ if (PL_copline > (line_t)$1)
PL_copline = (line_t)$1;
$$ = block_end($2, $3); }
;
mremember: /* NULL */ /* start a partial lexical scope */
{ $$ = block_start(FALSE); }
;
/* A collection of "lines" in the program */
lineseq : /* NULL */
{ $$ = Nullop; }
| lineseq decl
{ $$ = $1; }
| lineseq line
{ $$ = append_list(OP_LINESEQ,
(LISTOP*)$1, (LISTOP*)$2);
PL_pad_reset_pending = TRUE;
if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
;
/* A "line" in the program */
line : label cond
{ $$ = newSTATEOP(0, $1, $2); }
| loop /* loops add their own labels */
| label ';'
{ if ($1 != Nullch) {
$$ = newSTATEOP(0, $1, newOP(OP_NULL, 0));
}
else {
$$ = Nullop;
PL_copline = NOLINE;
}
PL_expect = XSTATE; }
| label sideff ';'
{ $$ = newSTATEOP(0, $1, $2);
PL_expect = XSTATE; }
;
/* An expression which may have a side-effect */
sideff : error
{ $$ = Nullop; }
| expr
{ $$ = $1; }
| expr IF expr
{ $$ = newLOGOP(OP_AND, 0, $3, $1); }
| expr UNLESS expr
{ $$ = newLOGOP(OP_OR, 0, $3, $1); }
| expr WHILE expr
{ $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
| expr UNTIL iexpr
{ $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
| expr FOR expr
{ $$ = newFOROP(0, Nullch, (line_t)$2,
Nullop, $3, $1, Nullop); }
;
/* else and elsif blocks */
else : /* NULL */
{ $$ = Nullop; }
| ELSE mblock
{ ($2)->op_flags |= OPf_PARENS; $$ = scope($2); }
| ELSIF '(' mexpr ')' mblock else
{ PL_copline = (line_t)$1;
$$ = newCONDOP(0, $3, scope($5), $6);
PL_hints |= HINT_BLOCK_SCOPE; }
;
/* Real conditional expressions */
cond : IF '(' remember mexpr ')' mblock else
{ PL_copline = (line_t)$1;
$$ = block_end($3,
newCONDOP(0, $4, scope($6), $7)); }
| UNLESS '(' remember miexpr ')' mblock else
{ PL_copline = (line_t)$1;
$$ = block_end($3,
newCONDOP(0, $4, scope($6), $7)); }
;
/* Continue blocks */
cont : /* NULL */
{ $$ = Nullop; }
| CONTINUE block
{ $$ = scope($2); }
;
/* Loops: while, until, for, and a bare block */
loop : label WHILE '(' remember mtexpr ')' mblock cont
{ PL_copline = (line_t)$2;
$$ = block_end($4,
newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
$2, $5, $7, $8))); }
| label UNTIL '(' remember miexpr ')' mblock cont
{ PL_copline = (line_t)$2;
$$ = block_end($4,
newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
$2, $5, $7, $8))); }
| label FOR MY remember my_scalar '(' mexpr ')' mblock cont
{ $$ = block_end($4,
newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); }
| label FOR scalar '(' remember mexpr ')' mblock cont
{ $$ = block_end($5,
newFOROP(0, $1, (line_t)$2, mod($3, OP_ENTERLOOP),
$6, $8, $9)); }
| label FOR '(' remember mexpr ')' mblock cont
{ $$ = block_end($4,
newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); }
| label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
/* basically fake up an initialize-while lineseq */
{ OP *forop;
PL_copline = (line_t)$2;
forop = newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
$2, scalar($7),
$11, $9));
if ($5) {
forop = append_elem(OP_LINESEQ,
newSTATEOP(0, ($1?savepv($1):Nullch),
$5),
forop);
}
$$ = block_end($4, forop); }
| label block cont /* a block is a loop that happens once */
{ $$ = newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
NOLINE, Nullop, $2, $3)); }
;
/* Normal expression */
nexpr : /* NULL */
{ $$ = Nullop; }
| sideff
;
/* Boolean expression */
texpr : /* NULL means true */
{ (void)scan_num("1", &yylval); $$ = yylval.opval; }
| expr
;
/* Inverted boolean expression */
iexpr : expr
{ $$ = invert(scalar($1)); }
;
/* Expression with its own lexical scope */
mexpr : expr
{ $$ = $1; intro_my(); }
;
mnexpr : nexpr
{ $$ = $1; intro_my(); }
;
mtexpr : texpr
{ $$ = $1; intro_my(); }
;
miexpr : iexpr
{ $$ = $1; intro_my(); }
;
/* Optional "MAIN:"-style loop labels */
label : /* empty */
{ $$ = Nullch; }
| LABEL
;
/* Some kind of declaration - does not take part in the parse tree */
decl : format
{ $$ = 0; }
| subrout
{ $$ = 0; }
| mysubrout
{ $$ = 0; }
| package
{ $$ = 0; }
| use
{ $$ = 0; }
;
format : FORMAT startformsub formname block
{ newFORM($2, $3, $4); }
;
formname: WORD { $$ = $1; }
| /* NULL */ { $$ = Nullop; }
;
/* Unimplemented "my sub foo { }" */
mysubrout: MYSUB startsub subname proto subattrlist subbody
{ newMYSUB($2, $3, $4, $5, $6); }
;
/* Subroutine definition */
subrout : SUB startsub subname proto subattrlist subbody
{ newATTRSUB($2, $3, $4, $5, $6); }
;
startsub: /* NULL */ /* start a regular subroutine scope */
{ $$ = start_subparse(FALSE, 0); }
;
startanonsub: /* NULL */ /* start an anonymous subroutine scope */
{ $$ = start_subparse(FALSE, CVf_ANON); }
;
startformsub: /* NULL */ /* start a format subroutine scope */
{ $$ = start_subparse(TRUE, 0); }
;
/* Name of a subroutine - must be a bareword, could be special */
subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT") || strEQ(name, "CHECK"))
CvSPECIAL_on(PL_compcv);
$$ = $1; }
;
/* Subroutine prototype */
proto : /* NULL */
{ $$ = Nullop; }
| THING
;
/* Optional list of subroutine attributes */
subattrlist: /* NULL */
{ $$ = Nullop; }
| COLONATTR THING
{ $$ = $2; }
| COLONATTR
{ $$ = Nullop; }
;
/* List of attributes for a "my" variable declaration */
myattrlist: COLONATTR THING
{ $$ = $2; }
| COLONATTR
{ $$ = Nullop; }
;
/* Subroutine body - either null or a block */
subbody : block { $$ = $1; }
| ';' { $$ = Nullop; PL_expect = XSTATE; }
;
package : PACKAGE WORD ';'
{ package($2); }
| PACKAGE ';'
{ package(Nullop); }
;
use : USE startsub
{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
WORD WORD listexpr ';'
{ utilize($1, $2, $4, $5, $6); }
;
/* Ordinary expressions; logical combinations */
expr : expr ANDOP expr
{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
| expr OROP expr
{ $$ = newLOGOP($2, 0, $1, $3); }
| argexpr %prec PREC_LOW
;
/* Expressions are a list of terms joined by commas */
argexpr : argexpr ','
{ $$ = $1; }
| argexpr ',' term
{ $$ = append_elem(OP_LIST, $1, $3); }
| term %prec PREC_LOW
;
/* List operators */
listop : LSTOP indirob argexpr /* map {...} @args or print $fh @args */
{ $$ = convert($1, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); }
| FUNC '(' indirob expr ')' /* print ($fh @args */
{ $$ = convert($1, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); }
| term ARROW method '(' listexprcom ')' /* $foo->bar(list) */
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, scalar($1), $5),
newUNOP(OP_METHOD, 0, $3))); }
| term ARROW method /* $foo->bar */
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, scalar($1),
newUNOP(OP_METHOD, 0, $3))); }
| METHOD indirob listexpr /* new Class @args */
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, $2, $3),
newUNOP(OP_METHOD, 0, $1))); }
| FUNCMETH indirob '(' listexprcom ')' /* method $object (@args) */
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, $2, $4),
newUNOP(OP_METHOD, 0, $1))); }
| LSTOP listexpr /* print @args */
{ $$ = convert($1, 0, $2); }
| FUNC '(' listexprcom ')' /* print (@args) */
{ $$ = convert($1, 0, $3); }
| LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */
{ $3 = newANONATTRSUB($2, 0, Nullop, $3); }
listexpr %prec LSTOP /* ... @bar */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, $3, $5), $1)); }
;
/* Names of methods. May use $object->$methodname */
method : METHOD
| scalar
;
/* Some kind of subscripted expression */
subscripted: star '{' expr ';' '}' /* *main::{something} */
/* In this and all the hash accessors, ';' is
* provided by the tokeniser */
{ $$ = newBINOP(OP_GELEM, 0, $1, scalar($3));
PL_expect = XOPERATOR; }
| scalar '[' expr ']' /* $array[$element] */
{ $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
| term ARROW '[' expr ']' /* somearef->[$element] */
{ $$ = newBINOP(OP_AELEM, 0,
ref(newAVREF($1),OP_RV2AV),
scalar($4));}
| subscripted '[' expr ']' /* $foo->[$bar]->[$baz] */
{ $$ = newBINOP(OP_AELEM, 0,
ref(newAVREF($1),OP_RV2AV),
scalar($3));}
| scalar '{' expr ';' '}' /* $foo->{bar();} */
{ $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
PL_expect = XOPERATOR; }
| term ARROW '{' expr ';' '}' /* somehref->{bar();} */
{ $$ = newBINOP(OP_HELEM, 0,
ref(newHVREF($1),OP_RV2HV),
jmaybe($4));
PL_expect = XOPERATOR; }
| subscripted '{' expr ';' '}' /* $foo->[bar]->{baz;} */
{ $$ = newBINOP(OP_HELEM, 0,
ref(newHVREF($1),OP_RV2HV),
jmaybe($3));
PL_expect = XOPERATOR; }
| term ARROW '(' ')' /* $subref->() */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar($1))); }
| term ARROW '(' expr ')' /* $subref->(@args) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $4,
newCVREF(0, scalar($1)))); }
| subscripted '(' expr ')' /* $foo->{bar}->(@args) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3,
newCVREF(0, scalar($1)))); }
| subscripted '(' ')' /* $foo->{bar}->() */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar($1))); }
;
/* Binary operators between terms */
termbinop : term ASSIGNOP term /* $x = $y */
{ $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); }
| term POWOP term /* $x ** $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term MULOP term /* $x * $y, $x x $y */
{ if ($2 != OP_REPEAT)
scalar($1);
$$ = newBINOP($2, 0, $1, scalar($3)); }
| term ADDOP term /* $x + $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term SHIFTOP term /* $x >> $y, $x << $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term RELOP term /* $x > $y, etc. */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term EQOP term /* $x == $y, $x eq $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term BITANDOP term /* $x & $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term BITOROP term /* $x | $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term DOTDOT term /* $x..$y, $x...$y */
{ $$ = newRANGE($2, scalar($1), scalar($3));}
| term ANDAND term /* $x && $y */
{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
| term OROR term /* $x || $y */
{ $$ = newLOGOP(OP_OR, 0, $1, $3); }
| term MATCHOP term /* $x =~ /$y/ */
{ $$ = bind_match($2, $1, $3); }
;
/* Unary operators and terms */
termunop : '-' term %prec UMINUS /* -$x */
{ $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
| '+' term %prec UMINUS /* +$x */
{ $$ = $2; }
| '!' term /* !$x */
{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
| '~' term /* ~$x */
{ $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
| term POSTINC /* $x++ */
{ $$ = newUNOP(OP_POSTINC, 0,
mod(scalar($1), OP_POSTINC)); }
| term POSTDEC /* $x-- */
{ $$ = newUNOP(OP_POSTDEC, 0,
mod(scalar($1), OP_POSTDEC)); }
| PREINC term /* ++$x */
{ $$ = newUNOP(OP_PREINC, 0,
mod(scalar($2), OP_PREINC)); }
| PREDEC term /* --$x */
{ $$ = newUNOP(OP_PREDEC, 0,
mod(scalar($2), OP_PREDEC)); }
;
/* Constructors for anonymous data */
anonymous: '[' expr ']'
{ $$ = newANONLIST($2); }
| '[' ']'
{ $$ = newANONLIST(Nullop); }
| HASHBRACK expr ';' '}' %prec '(' /* { foo => "Bar" } */
{ $$ = newANONHASH($2); }
| HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */
{ $$ = newANONHASH(Nullop); }
| ANONSUB startanonsub proto subattrlist block %prec '('
{ $$ = newANONATTRSUB($2, $3, $4, $5); }
;
/* Things called with "do" */
termdo : DO term %prec UNIOP /* do $filename */
{ $$ = dofile($2); }
| DO block %prec '(' /* do { code */
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
| DO WORD '(' ')' /* do somesub() */
{ $$ = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
scalar(newCVREF(
(OPpENTERSUB_AMPER<<8),
scalar($2)
)),Nullop)); dep();}
| DO WORD '(' expr ')' /* do somesub(@args) */
{ $$ = newUNOP(OP_ENTERSUB,
OPf_SPECIAL|OPf_STACKED,
append_elem(OP_LIST,
$4,
scalar(newCVREF(
(OPpENTERSUB_AMPER<<8),
scalar($2)
)))); dep();}
| DO scalar '(' ')' /* do $subref () */
{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
scalar(newCVREF(0,scalar($2))), Nullop)); dep();}
| DO scalar '(' expr ')' /* do $subref (@args) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
prepend_elem(OP_LIST,
$4,
scalar(newCVREF(0,scalar($2))))); dep();}
;
term : termbinop
| termunop
| anonymous
| termdo
| term '?' term ':' term
{ $$ = newCONDOP(0, $1, $3, $5); }
| REFGEN term /* \$x, \@y, \%z */
{ $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); }
| myattrterm %prec UNIOP
{ $$ = $1; }
| LOCAL term %prec UNIOP
{ $$ = localize($2,$1); }
| '(' expr ')'
{ $$ = sawparens($2); }
| '(' ')'
{ $$ = sawparens(newNULLLIST()); }
| scalar %prec '('
{ $$ = $1; }
| star %prec '('
{ $$ = $1; }
| hsh %prec '('
{ $$ = $1; }
| ary %prec '('
{ $$ = $1; }
| arylen %prec '(' /* $#x, $#{ something } */
{ $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
| subscripted
{ $$ = $1; }
| '(' expr ')' '[' expr ']' /* list slice */
{ $$ = newSLICEOP(0, $5, $2); }
| '(' ')' '[' expr ']' /* empty list slice! */
{ $$ = newSLICEOP(0, $4, Nullop); }
| ary '[' expr ']' /* array slice */
{ $$ = prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
list($3),
ref($1, OP_ASLICE))); }
| ary '{' expr ';' '}' /* @hash{@keys} */
{ $$ = prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
list($3),
ref(oopsHV($1), OP_HSLICE)));
PL_expect = XOPERATOR; }
| THING %prec '('
{ $$ = $1; }
| amper /* &foo; */
{ $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
| amper '(' ')' /* &foo() */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
| amper '(' expr ')' /* &foo(@args) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3, scalar($1))); }
| NOAMP WORD listexpr /* foo(@args) */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3, scalar($2))); }
| LOOPEX /* loop exiting command (goto, last, dump, etc) */
{ $$ = newOP($1, OPf_SPECIAL);
PL_hints |= HINT_BLOCK_SCOPE; }
| LOOPEX term
{ $$ = newLOOPEX($1,$2); }
| NOTOP argexpr /* not $foo */
{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
| UNIOP /* Unary op, $_ implied */
{ $$ = newOP($1, 0); }
| UNIOP block /* eval { foo }, I *think* */
{ $$ = newUNOP($1, 0, $2); }
| UNIOP term /* Unary op */
{ $$ = newUNOP($1, 0, $2); }
| UNIOPSUB term /* Sub treated as unop */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $2, scalar($1))); }
| FUNC0 /* Nullary operator */
{ $$ = newOP($1, 0); }
| FUNC0 '(' ')'
{ $$ = newOP($1, 0); }
| FUNC0SUB /* Sub treated as nullop */
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar($1)); }
| FUNC1 '(' ')' /* not () */
{ $$ = $1 == OP_NOT ? newUNOP($1, 0, newSVOP(OP_CONST, 0, newSViv(0)))
: newOP($1, OPf_SPECIAL); }
| FUNC1 '(' expr ')' /* not($foo) */
{ $$ = newUNOP($1, 0, $3); }
| PMFUNC '(' term ')' /* split (/foo/) */
{ $$ = pmruntime($1, $3, Nullop); }
| PMFUNC '(' term ',' term ')' /* split (/foo/,$bar) */
{ $$ = pmruntime($1, $3, $5); }
| WORD
| listop
;
/* "my" declarations, with optional attributes */
myattrterm: MY myterm myattrlist
{ $$ = my_attrs($2,$3); }
| MY myterm
{ $$ = localize($2,$1); }
;
/* Things that can be "my"'d */
myterm : '(' expr ')'
{ $$ = sawparens($2); }
| '(' ')'
{ $$ = sawparens(newNULLLIST()); }
| scalar %prec '('
{ $$ = $1; }
| hsh %prec '('
{ $$ = $1; }
| ary %prec '('
{ $$ = $1; }
;
/* Basic list expressions */
listexpr: /* NULL */ %prec PREC_LOW
{ $$ = Nullop; }
| argexpr %prec PREC_LOW
{ $$ = $1; }
;
listexprcom: /* NULL */
{ $$ = Nullop; }
| expr
{ $$ = $1; }
| expr ','
{ $$ = $1; }
;
/* A little bit of trickery to make "for my $foo (@bar)" actually be
lexical */
my_scalar: scalar
{ PL_in_my = 0; $$ = my($1); }
;
amper : '&' indirob
{ $$ = newCVREF($1,$2); }
;
scalar : '$' indirob
{ $$ = newSVREF($2); }
;
ary : '@' indirob
{ $$ = newAVREF($2); }
;
hsh : '%' indirob
{ $$ = newHVREF($2); }
;
arylen : DOLSHARP indirob
{ $$ = newAVREF($2); }
;
star : '*' indirob
{ $$ = newGVREF(0,$2); }
;
/* Indirect objects */
indirob : WORD
{ $$ = scalar($1); }
| scalar %prec PREC_LOW
{ $$ = scalar($1); }
| block
{ $$ = scope($1); }
| PRIVATEREF
{ $$ = $1; }
;
%% /* PROGRAM */
/* more stuff added to make perly_c.diff easier to apply */
#ifdef yyparse
#undef yyparse
#endif
#define yyparse() Perl_yyparse(pTHX)
--- NEW FILE: opnames.h ---
/* -*- buffer-read-only: t -*-
*
* opnames.h
*
* Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by opcode.pl from its data. Any changes made here
* will be lost!
*/
typedef enum opcode {
OP_NULL, /* 0 */
OP_STUB, /* 1 */
OP_SCALAR, /* 2 */
OP_PUSHMARK, /* 3 */
OP_WANTARRAY, /* 4 */
OP_CONST, /* 5 */
OP_GVSV, /* 6 */
OP_GV, /* 7 */
OP_GELEM, /* 8 */
OP_PADSV, /* 9 */
OP_PADAV, /* 10 */
OP_PADHV, /* 11 */
OP_PADANY, /* 12 */
OP_PUSHRE, /* 13 */
OP_RV2GV, /* 14 */
OP_RV2SV, /* 15 */
OP_AV2ARYLEN, /* 16 */
OP_RV2CV, /* 17 */
OP_ANONCODE, /* 18 */
OP_PROTOTYPE, /* 19 */
OP_REFGEN, /* 20 */
OP_SREFGEN, /* 21 */
OP_REF, /* 22 */
OP_BLESS, /* 23 */
OP_BACKTICK, /* 24 */
OP_GLOB, /* 25 */
OP_READLINE, /* 26 */
OP_RCATLINE, /* 27 */
OP_REGCMAYBE, /* 28 */
OP_REGCRESET, /* 29 */
OP_REGCOMP, /* 30 */
OP_MATCH, /* 31 */
OP_QR, /* 32 */
OP_SUBST, /* 33 */
OP_SUBSTCONT, /* 34 */
OP_TRANS, /* 35 */
OP_SASSIGN, /* 36 */
OP_AASSIGN, /* 37 */
OP_CHOP, /* 38 */
OP_SCHOP, /* 39 */
OP_CHOMP, /* 40 */
OP_SCHOMP, /* 41 */
OP_DEFINED, /* 42 */
OP_UNDEF, /* 43 */
OP_STUDY, /* 44 */
OP_POS, /* 45 */
OP_PREINC, /* 46 */
OP_I_PREINC, /* 47 */
OP_PREDEC, /* 48 */
OP_I_PREDEC, /* 49 */
OP_POSTINC, /* 50 */
OP_I_POSTINC, /* 51 */
OP_POSTDEC, /* 52 */
OP_I_POSTDEC, /* 53 */
OP_POW, /* 54 */
OP_MULTIPLY, /* 55 */
OP_I_MULTIPLY, /* 56 */
OP_DIVIDE, /* 57 */
OP_I_DIVIDE, /* 58 */
OP_MODULO, /* 59 */
OP_I_MODULO, /* 60 */
OP_REPEAT, /* 61 */
OP_ADD, /* 62 */
OP_I_ADD, /* 63 */
OP_SUBTRACT, /* 64 */
OP_I_SUBTRACT, /* 65 */
OP_CONCAT, /* 66 */
OP_STRINGIFY, /* 67 */
OP_LEFT_SHIFT, /* 68 */
OP_RIGHT_SHIFT, /* 69 */
OP_LT, /* 70 */
OP_I_LT, /* 71 */
OP_GT, /* 72 */
OP_I_GT, /* 73 */
OP_LE, /* 74 */
OP_I_LE, /* 75 */
OP_GE, /* 76 */
OP_I_GE, /* 77 */
OP_EQ, /* 78 */
OP_I_EQ, /* 79 */
OP_NE, /* 80 */
OP_I_NE, /* 81 */
OP_NCMP, /* 82 */
OP_I_NCMP, /* 83 */
OP_SLT, /* 84 */
OP_SGT, /* 85 */
OP_SLE, /* 86 */
OP_SGE, /* 87 */
OP_SEQ, /* 88 */
OP_SNE, /* 89 */
OP_SCMP, /* 90 */
OP_BIT_AND, /* 91 */
OP_BIT_XOR, /* 92 */
OP_BIT_OR, /* 93 */
OP_NEGATE, /* 94 */
OP_I_NEGATE, /* 95 */
OP_NOT, /* 96 */
OP_COMPLEMENT, /* 97 */
OP_ATAN2, /* 98 */
OP_SIN, /* 99 */
OP_COS, /* 100 */
OP_RAND, /* 101 */
OP_SRAND, /* 102 */
OP_EXP, /* 103 */
OP_LOG, /* 104 */
OP_SQRT, /* 105 */
OP_INT, /* 106 */
OP_HEX, /* 107 */
OP_OCT, /* 108 */
OP_ABS, /* 109 */
OP_LENGTH, /* 110 */
OP_SUBSTR, /* 111 */
OP_VEC, /* 112 */
OP_INDEX, /* 113 */
OP_RINDEX, /* 114 */
OP_SPRINTF, /* 115 */
OP_FORMLINE, /* 116 */
OP_ORD, /* 117 */
OP_CHR, /* 118 */
OP_CRYPT, /* 119 */
OP_UCFIRST, /* 120 */
OP_LCFIRST, /* 121 */
OP_UC, /* 122 */
OP_LC, /* 123 */
OP_QUOTEMETA, /* 124 */
OP_RV2AV, /* 125 */
OP_AELEMFAST, /* 126 */
OP_AELEM, /* 127 */
OP_ASLICE, /* 128 */
OP_EACH, /* 129 */
OP_VALUES, /* 130 */
OP_KEYS, /* 131 */
OP_DELETE, /* 132 */
OP_EXISTS, /* 133 */
OP_RV2HV, /* 134 */
OP_HELEM, /* 135 */
OP_HSLICE, /* 136 */
OP_UNPACK, /* 137 */
OP_PACK, /* 138 */
OP_SPLIT, /* 139 */
OP_JOIN, /* 140 */
OP_LIST, /* 141 */
OP_LSLICE, /* 142 */
OP_ANONLIST, /* 143 */
OP_ANONHASH, /* 144 */
OP_SPLICE, /* 145 */
OP_PUSH, /* 146 */
OP_POP, /* 147 */
OP_SHIFT, /* 148 */
OP_UNSHIFT, /* 149 */
OP_SORT, /* 150 */
OP_REVERSE, /* 151 */
OP_GREPSTART, /* 152 */
OP_GREPWHILE, /* 153 */
OP_MAPSTART, /* 154 */
OP_MAPWHILE, /* 155 */
OP_RANGE, /* 156 */
OP_FLIP, /* 157 */
OP_FLOP, /* 158 */
OP_AND, /* 159 */
OP_OR, /* 160 */
OP_XOR, /* 161 */
OP_COND_EXPR, /* 162 */
OP_ANDASSIGN, /* 163 */
OP_ORASSIGN, /* 164 */
OP_METHOD, /* 165 */
OP_ENTERSUB, /* 166 */
OP_LEAVESUB, /* 167 */
OP_LEAVESUBLV, /* 168 */
OP_CALLER, /* 169 */
OP_WARN, /* 170 */
OP_DIE, /* 171 */
OP_RESET, /* 172 */
OP_LINESEQ, /* 173 */
OP_NEXTSTATE, /* 174 */
OP_DBSTATE, /* 175 */
OP_UNSTACK, /* 176 */
OP_ENTER, /* 177 */
OP_LEAVE, /* 178 */
OP_SCOPE, /* 179 */
OP_ENTERITER, /* 180 */
OP_ITER, /* 181 */
OP_ENTERLOOP, /* 182 */
OP_LEAVELOOP, /* 183 */
OP_RETURN, /* 184 */
OP_LAST, /* 185 */
OP_NEXT, /* 186 */
OP_REDO, /* 187 */
OP_DUMP, /* 188 */
OP_GOTO, /* 189 */
OP_EXIT, /* 190 */
OP_OPEN, /* 191 */
OP_CLOSE, /* 192 */
OP_PIPE_OP, /* 193 */
OP_FILENO, /* 194 */
OP_UMASK, /* 195 */
OP_BINMODE, /* 196 */
OP_TIE, /* 197 */
OP_UNTIE, /* 198 */
OP_TIED, /* 199 */
OP_DBMOPEN, /* 200 */
OP_DBMCLOSE, /* 201 */
OP_SSELECT, /* 202 */
OP_SELECT, /* 203 */
OP_GETC, /* 204 */
OP_READ, /* 205 */
OP_ENTERWRITE, /* 206 */
OP_LEAVEWRITE, /* 207 */
OP_PRTF, /* 208 */
OP_PRINT, /* 209 */
OP_SYSOPEN, /* 210 */
OP_SYSSEEK, /* 211 */
OP_SYSREAD, /* 212 */
OP_SYSWRITE, /* 213 */
OP_SEND, /* 214 */
OP_RECV, /* 215 */
OP_EOF, /* 216 */
OP_TELL, /* 217 */
OP_SEEK, /* 218 */
OP_TRUNCATE, /* 219 */
OP_FCNTL, /* 220 */
OP_IOCTL, /* 221 */
OP_FLOCK, /* 222 */
OP_SOCKET, /* 223 */
OP_SOCKPAIR, /* 224 */
OP_BIND, /* 225 */
OP_CONNECT, /* 226 */
OP_LISTEN, /* 227 */
OP_ACCEPT, /* 228 */
OP_SHUTDOWN, /* 229 */
OP_GSOCKOPT, /* 230 */
OP_SSOCKOPT, /* 231 */
OP_GETSOCKNAME, /* 232 */
OP_GETPEERNAME, /* 233 */
OP_LSTAT, /* 234 */
OP_STAT, /* 235 */
OP_FTRREAD, /* 236 */
OP_FTRWRITE, /* 237 */
OP_FTREXEC, /* 238 */
OP_FTEREAD, /* 239 */
OP_FTEWRITE, /* 240 */
OP_FTEEXEC, /* 241 */
OP_FTIS, /* 242 */
OP_FTEOWNED, /* 243 */
OP_FTROWNED, /* 244 */
OP_FTZERO, /* 245 */
OP_FTSIZE, /* 246 */
OP_FTMTIME, /* 247 */
OP_FTATIME, /* 248 */
OP_FTCTIME, /* 249 */
OP_FTSOCK, /* 250 */
OP_FTCHR, /* 251 */
OP_FTBLK, /* 252 */
OP_FTFILE, /* 253 */
OP_FTDIR, /* 254 */
OP_FTPIPE, /* 255 */
OP_FTLINK, /* 256 */
OP_FTSUID, /* 257 */
OP_FTSGID, /* 258 */
OP_FTSVTX, /* 259 */
OP_FTTTY, /* 260 */
OP_FTTEXT, /* 261 */
OP_FTBINARY, /* 262 */
OP_CHDIR, /* 263 */
OP_CHOWN, /* 264 */
OP_CHROOT, /* 265 */
OP_UNLINK, /* 266 */
OP_CHMOD, /* 267 */
OP_UTIME, /* 268 */
OP_RENAME, /* 269 */
OP_LINK, /* 270 */
OP_SYMLINK, /* 271 */
OP_READLINK, /* 272 */
OP_MKDIR, /* 273 */
OP_RMDIR, /* 274 */
OP_OPEN_DIR, /* 275 */
OP_READDIR, /* 276 */
OP_TELLDIR, /* 277 */
OP_SEEKDIR, /* 278 */
OP_REWINDDIR, /* 279 */
OP_CLOSEDIR, /* 280 */
OP_FORK, /* 281 */
OP_WAIT, /* 282 */
OP_WAITPID, /* 283 */
OP_SYSTEM, /* 284 */
OP_EXEC, /* 285 */
OP_KILL, /* 286 */
OP_GETPPID, /* 287 */
OP_GETPGRP, /* 288 */
OP_SETPGRP, /* 289 */
OP_GETPRIORITY, /* 290 */
OP_SETPRIORITY, /* 291 */
OP_TIME, /* 292 */
OP_TMS, /* 293 */
OP_LOCALTIME, /* 294 */
OP_GMTIME, /* 295 */
OP_ALARM, /* 296 */
OP_SLEEP, /* 297 */
OP_SHMGET, /* 298 */
OP_SHMCTL, /* 299 */
OP_SHMREAD, /* 300 */
OP_SHMWRITE, /* 301 */
OP_MSGGET, /* 302 */
OP_MSGCTL, /* 303 */
OP_MSGSND, /* 304 */
OP_MSGRCV, /* 305 */
OP_SEMGET, /* 306 */
OP_SEMCTL, /* 307 */
OP_SEMOP, /* 308 */
OP_REQUIRE, /* 309 */
OP_DOFILE, /* 310 */
OP_ENTEREVAL, /* 311 */
OP_LEAVEEVAL, /* 312 */
OP_ENTERTRY, /* 313 */
OP_LEAVETRY, /* 314 */
OP_GHBYNAME, /* 315 */
OP_GHBYADDR, /* 316 */
OP_GHOSTENT, /* 317 */
OP_GNBYNAME, /* 318 */
OP_GNBYADDR, /* 319 */
OP_GNETENT, /* 320 */
OP_GPBYNAME, /* 321 */
OP_GPBYNUMBER, /* 322 */
OP_GPROTOENT, /* 323 */
OP_GSBYNAME, /* 324 */
OP_GSBYPORT, /* 325 */
OP_GSERVENT, /* 326 */
OP_SHOSTENT, /* 327 */
OP_SNETENT, /* 328 */
OP_SPROTOENT, /* 329 */
OP_SSERVENT, /* 330 */
OP_EHOSTENT, /* 331 */
OP_ENETENT, /* 332 */
OP_EPROTOENT, /* 333 */
OP_ESERVENT, /* 334 */
OP_GPWNAM, /* 335 */
OP_GPWUID, /* 336 */
OP_GPWENT, /* 337 */
OP_SPWENT, /* 338 */
OP_EPWENT, /* 339 */
OP_GGRNAM, /* 340 */
OP_GGRGID, /* 341 */
OP_GGRENT, /* 342 */
OP_SGRENT, /* 343 */
OP_EGRENT, /* 344 */
OP_GETLOGIN, /* 345 */
OP_SYSCALL, /* 346 */
OP_LOCK, /* 347 */
OP_THREADSV, /* 348 */
OP_SETSTATE, /* 349 */
OP_METHOD_NAMED,/* 350 */
OP_CUSTOM, /* 351 */
OP_max
} opcode;
#define MAXO 352
#define OP_phoney_INPUT_ONLY -1
#define OP_phoney_OUTPUT_ONLY -2
#define OP_IS_SOCKET(op) \
((op) == OP_ACCEPT || \
(op) == OP_BIND || \
(op) == OP_CONNECT || \
(op) == OP_GETPEERNAME || \
(op) == OP_GETSOCKNAME || \
(op) == OP_GSOCKOPT || \
(op) == OP_LISTEN || \
(op) == OP_RECV || \
(op) == OP_SEND || \
(op) == OP_SHUTDOWN || \
(op) == OP_SOCKET || \
(op) == OP_SOCKPAIR || \
(op) == OP_SSOCKOPT)
#define OP_IS_FILETEST(op) \
((op) == OP_FTATIME || \
(op) == OP_FTBINARY || \
(op) == OP_FTBLK || \
(op) == OP_FTCHR || \
(op) == OP_FTCTIME || \
(op) == OP_FTDIR || \
(op) == OP_FTEEXEC || \
(op) == OP_FTEOWNED || \
(op) == OP_FTEREAD || \
(op) == OP_FTEWRITE || \
(op) == OP_FTFILE || \
(op) == OP_FTIS || \
(op) == OP_FTLINK || \
(op) == OP_FTMTIME || \
(op) == OP_FTPIPE || \
(op) == OP_FTREXEC || \
(op) == OP_FTROWNED || \
(op) == OP_FTRREAD || \
(op) == OP_FTRWRITE || \
(op) == OP_FTSGID || \
(op) == OP_FTSIZE || \
(op) == OP_FTSOCK || \
(op) == OP_FTSUID || \
(op) == OP_FTSVTX || \
(op) == OP_FTTEXT || \
(op) == OP_FTTTY || \
(op) == OP_FTZERO)
/* ex: set ro: */
--- NEW FILE: README.netware ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
perlnetware - Perl for NetWare
=head1 DESCRIPTION
This file gives instructions for building Perl 5.7 and above, and also
Perl modules for NetWare. Before you start, you may want to read the
README file found in the top level directory into which the Perl source
code distribution was extracted. Make sure you read and understand
the terms under which the software is being distributed.
=head1 BUILD
This section describes the steps to be performed to build a Perl NLM
and other associated NLMs.
=head2 Tools & SDK
The build requires CodeWarrior compiler and linker. In addition,
the "NetWare SDK", "NLM & NetWare Libraries for C" and
"NetWare Server Protocol Libraries for C", all available at
L<http://developer.novell.com/ndk/>, are also required.
Microsoft Visual C++ version 4.2 or later is also required.
=head2 Setup
The build process is dependent on the location of the NetWare SDK.
Once the Tools & SDK are installed, the build environment has to
be setup. The following batch files setup the environment.
=over 4
=item SetNWBld.bat
The Execution of this file takes 2 parameters as input. The first
being the NetWare SDK path, second being the path for CodeWarrior
Compiler & tools. Execution of this file sets these paths and also
sets the build type to Release by default.
=item Buildtype.bat
This is used to set the build type to debug or release. Change the
build type only after executing SetNWBld.bat
=item *
Example:
1. Typing "buildtype d on" at the command prompt causes the buildtype
to be set to Debug type with D2 flag set.
2. Typing "buildtype d off" or "buildtype d" at the command prompt causes
the buildtype to be set to Debug type with D1 flag set.
2. Typing "buildtype r" at the command prompt sets it to Release Build type.
=back
=head2 Make
The make process runs only under WinNT shell. The NetWare makefile is
located under the NetWare folder. This makes use of miniperl.exe to
run some of the Perl scripts. To create miniperl.exe, first set the
required paths for Visual c++ compilier (specify vcvars32 location) at
the command prompt. Then run nmake from win32 folder through WinNT
command prompt. The build process can be stopped after miniperl.exe
is created. Then run nmake from NetWare folder through WinNT command
prompt.
Currently the following two build types are tested on NetWare:
=over 4
=item *
USE_MULTI, USE_ITHREADS & USE_IMP_SYS defined
=item *
USE_MULTI & USE_IMP_SYS defined and USE_ITHREADS not defined
=back
=head2 Interpreter
Once miniperl.exe creation is over, run nmake from the NetWare folder.
This will build the Perl interpreter for NetWare as I<perl.nlm>.
This is copied under the I<Release> folder if you are doing
a release build, else will be copied under I<Debug> folder for debug builds.
=head2 Extensions
The make process also creates the Perl extensions as I<<Extension>.nlm>
=head1 INSTALL
To install NetWare Perl onto a NetWare server, first map the Sys
volume of a NetWare server to I<i:>. This is because the makefile by
default sets the drive letter to I<i:>. Type I<nmake nwinstall> from
NetWare folder on a WinNT command prompt. This will copy the binaries
and module files onto the NetWare server under I<sys:\Perl>
folder. The Perl interpreter, I<perl.nlm>, is copied under
I<sys:\perl\system> folder. Copy this to I<sys:\system> folder.
Example: At the command prompt Type "nmake nwinstall".
This will install NetWare Perl on the NetWare Server.
Similiarly if you type "nmake install",
This will cause the binaries to be installed on the local machine.
(Typically under the c:\perl folder)
=head1 BUILD NEW EXTENSIONS
To build extensions other than standard extensions, NetWare Perl has
to be installed on Windows along with Windows Perl. The Perl for
Windows can be either downloaded from the CPAN site and built using
the sources, or the binaries can be directly downloaded from the
ActiveState site. Installation can be done by invoking I<nmake
install> from the NetWare folder on a WinNT command prompt after
building NetWare Perl by following steps given above. This will copy
all the *.pm files and other required files. Documentation files are
not copied. Thus one must first install Windows Perl, Then install
NetWare Perl.
Once this is done, do the following to build any extension:
=over 4
=item *
Change to the extension directory where its source files are present.
=item *
Run the following command at the command prompt:
perl -II<path to NetWare lib dir> -II<path to lib> Makefile.pl
Example:
perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread -Ic:\perl\5.6.1\lib MakeFile.pl
or
perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread -Ic:\perl\5.8.0\lib MakeFile.pl
=item *
nmake
=item *
nmake install
Install will copy the files into the Windows machine where NetWare
Perl is installed and these files may have to be copied to the NetWare
server manually. Alternatively, pass I<INSTALLSITELIB=i:\perl\lib> as
an input to makefile.pl above. Here I<i:> is the mapped drive to the
sys: volume of the server where Perl on NetWare is installed. Now
typing I<nmake install>, will copy the files onto the NetWare server.
Example: You can execute the following on the command prompt.
perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread -Ic:\perl\5.6.1\lib MakeFile.pl
INSTALLSITELIB=i:\perl\lib
or
perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread -Ic:\perl\5.8.0\lib MakeFile.pl
INSTALLSITELIB=i:\perl\lib
=item *
Note: Some modules downloaded from CPAN may require NetWare related
API in order to build on NetWare. Other modules may however build
smoothly with or without minor changes depending on the type of
module.
=back
=head1 ACKNOWLEDGEMENTS
The makefile for Win32 is used as a reference to create the makefile
for NetWare. Also, the make process for NetWare port uses
miniperl.exe to run scripts during the make and installation process.
=head1 AUTHORS
Anantha Kesari H Y (hyanantha at novell.com)
Aditya C (caditya at novell.com)
=head1 DATE
=over 4
=item *
Created - 18 Jan 2001
=item *
Modified - 25 June 2001
=item *
Modified - 13 July 2001
=item *
Modified - 28 May 2002
=back
--- NEW FILE: Changes5.002 ---
-------------
Version 5.002
-------------
The main enhancement to the Perl core was the addition of prototypes.
Many of the modules that come with Perl have been extensively upgraded.
Other than that, nearly all the changes for 5.002 were bug fixes of one
variety or another, so here's the bug list, along with the "resolution"
for each of them. If you wish to correspond about any of them, please
include the bug number (if any).
Changes specific to the Configure and build process are described
at the bottom.
Added APPLLIB_EXP for embedded perl library support.
Files patched: perl.c
Couldn't define autoloaded routine by assignment to typeglob.
[...3964 lines suppressed...]
Index: x2p/a2p.h
Add OS/2 stuff.
*** perl5.001.lwall/x2p/a2p.h Thu Oct 19 21:03:58 1995
--- perl5.002beta1/x2p/a2p.h Tue Nov 14 10:46:57 1995
Index: x2p/cflags.SH
Add .obj for OS/2.
*** perl5.001.lwall/x2p/cflags.SH Tue Oct 18 12:47:34 1994
--- perl5.002beta1/x2p/cflags.SH Tue Nov 14 15:18:27 1995
Index: x2p/find2perl.PL
Changed from .SH to .PL.
*** /dev/null Mon Nov 20 17:28:51 1995
--- perl5.002beta1/x2p/find2perl.PL Sun Nov 19 23:11:58 1995
Index: x2p/s2p.PL
Changed from .SH to .PL extraction.
*** /dev/null Mon Nov 20 17:28:51 1995
--- perl5.002beta1/x2p/s2p.PL Sun Nov 19 23:14:59 1995
--- NEW FILE: Policy_sh.SH ---
case $PERL_CONFIG_SH in
'') . ./config.sh ;;
esac
echo "Extracting Policy.sh (with variable substitutions)"
$spitshell <<!GROK!THIS! >Policy.sh
$startsh
#
# This file was produced by running the Policy_sh.SH script, which
# gets its values from config.sh, which is generally produced by
# running Configure.
#
# The idea here is to distill in one place the common site-wide
# "policy" answers (such as installation directories) that are
# to be "sticky". If you keep the file Policy.sh around in
# the same directory as you are building Perl, then Configure will
# (by default) load up the Policy.sh file just before the
# platform-specific hints file and rewrite it at the end.
#
# The sequence of events is as follows:
# A: If you are NOT re-using an old config.sh:
# 1. At start-up, Configure loads up the defaults from the
# os-specific hints/osname_osvers.sh file and any previous
# Policy.sh file.
# 2. At the end, Configure runs Policy_sh.SH, which creates
# Policy.sh, overwriting a previous Policy.sh if necessary.
#
# B: If you are re-using an old config.sh:
# 1. At start-up, Configure loads up the defaults from config.sh,
# ignoring any previous Policy.sh file.
# 2. At the end, Configure runs Policy_sh.SH, which creates
# Policy.sh, overwriting a previous Policy.sh if necessary.
#
# Thus the Policy.sh file gets overwritten each time
# Configure is run. Any variables you add to Policy.sh will be lost
# unless you copy Policy.sh somewhere else before running Configure.
#
# Allow Configure command-line overrides; usually these won't be
# needed, but something like -Dprefix=/test/location can be quite
# useful for testing out new versions.
#Site-specific values:
case "\$perladmin" in
'') perladmin='$perladmin' ;;
esac
# Installation prefixes. Allow a Configure -D override. You
# may wish to reinstall perl under a different prefix, perhaps
# in order to test a different configuration.
# For an explanation of the installation directories, see the
# INSTALL file section on "Installation Directories".
case "\$prefix" in
'') prefix='$prefix' ;;
esac
# By default, the next three are the same as \$prefix.
# If the user changes \$prefix, and previously \$siteprefix was the
# same as \$prefix, then change \$siteprefix as well.
# Use similar logic for \$vendorprefix and \$installprefix.
case "\$siteprefix" in
'') if test "$siteprefix" = "$prefix"; then
siteprefix="\$prefix"
else
siteprefix='$siteprefix'
fi
;;
esac
case "\$vendorprefix" in
'') if test "$vendorprefix" = "$prefix"; then
vendorprefix="\$prefix"
else
vendorprefix='$vendorprefix'
fi
;;
esac
# Where installperl puts things.
case "\$installprefix" in
'') if test "$installprefix" = "$prefix"; then
installprefix="\$prefix"
else
installprefix='$installprefix'
fi
;;
esac
# Installation directives. Note that each one comes in three flavors.
# For example, we have privlib, privlibexp, and installprivlib.
# privlib is for private (to perl) library files.
# privlibexp is the same, except any '~' the user gave to Configure
# is expanded to the user's home directory. This is figured
# out automatically by Configure, so you don't have to include it here.
# installprivlib is for systems (such as those running AFS) that
# need to distinguish between the place where things
# get installed and where they finally will reside. As of 5.005_6x,
# this too is handled automatically by Configure based on
# $installprefix, so it isn't included here either.
#
# Note also that there are three broad hierarchies of installation
# directories, as discussed in the INSTALL file under
# "Installation Directories":
#
# =item Directories for the perl distribution
#
# =item Directories for site-specific add-on files
#
# =item Directories for vendor-supplied add-on files
#
# See Porting/Glossary for the definitions of these names, and see the
# INSTALL file for further explanation and some examples.
#
# In each case, if your previous value was the default, leave it commented
# out. That way, if you override prefix, all of these will be
# automatically adjusted.
#
# WARNING: Be especially careful about architecture-dependent and
# version-dependent names, particularly if you reuse this file for
# different versions of perl.
!GROK!THIS!
# Set the following variables. Mention them here so metaconfig
# includes the appropriate code in Configure
# $bin $scriptdir $privlib $archlib
# $man1dir $man3dir $html1dir $html3dir
# $sitebin $sitescript $sitelib $sitearch
# $siteman1dir $siteman3dir $sitehtml1dir $sitehtml3dir
# $vendorbin $vendorscript $vendorlib $vendorarch
# $vendorman1dir $vendorman3dir $vendorhtml1dir $vendorhtml3dir
for var in \
bin scriptdir privlib archlib man1dir man3dir html1dir html3dir \
sitebin sitescript sitelib sitearch \
siteman1dir siteman3dir sitehtml1dir sitehtml3dir \
vendorbin vendorscript vendorlib vendorarch \
vendorman1dir vendorman3dir vendorhtml1dir vendorhtml3dir
do
case "$var" in
# Directories for the core perl components
bin) dflt=$prefix/bin ;;
# The scriptdir test is more complex, but this is probably usually ok.
scriptdir)
if $test -d $prefix/script; then
dflt=$prefix/script
else
dflt=$bin
fi
;;
privlib)
case "$prefix" in
*perl*) dflt=$prefix/lib/$version ;;
*) dflt=$prefix/lib/$package/$version ;;
esac
;;
archlib) dflt="$privlib/$archname" ;;
man1dir) dflt="$prefix/man/man1" ;;
man3dir) dflt="$prefix/man/man3" ;;
# Can we assume all sed's have greedy matching?
man1ext) dflt=`echo $man1dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;;
man3ext) dflt=`echo $man3dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;;
# We don't know what to do with these yet.
html1dir) dflt='' ;;
htm31dir) dflt='' ;;
# Directories for site-specific add-on files
sitebin) dflt=$siteprefix/bin ;;
sitescript)
if $test -d $siteprefix/script; then
dflt=$siteprefix/script
else
dflt=$sitebin
fi
;;
sitelib)
case "$siteprefix" in
*perl*) dflt=$prefix/lib/site_perl/$version ;;
*) dflt=$prefix/lib/$package/site_perl/$version ;;
esac
;;
sitearch) dflt="$sitelib/$archname" ;;
siteman1) dflt="$siteprefix/man/man1" ;;
siteman3) dflt="$siteprefix/man/man3" ;;
# We don't know what to do with these yet.
sitehtml1) dflt='' ;;
sitehtm31dir) dflt='' ;;
# Directories for vendor-supplied add-on files
# These are all usually empty.
vendor*)
if test X"$vendorprefix" = X""; then
dflt=''
else
case "$var" in
vendorbin) dflt=$vendorprefix/bin ;;
vendorscript)
if $test -d $vendorprefix/script; then
dflt=$vendorprefix/script
else
dflt=$vendorbin
fi
;;
vendorlib)
case "$vendorprefix" in
*perl*) dflt=$prefix/lib/vendor_perl/$version ;;
*) dflt=$prefix/lib/$package/vendor_perl/$version ;;
esac
;;
vendorarch) dflt="$vendorlib/$archname" ;;
vendorman1) dflt="$vendorprefix/man/man1" ;;
vendorman3) dflt="$vendorprefix/man/man3" ;;
# We don't know what to do with these yet.
vendorhtml1) dflt='' ;;
vendorhtm3) dflt='' ;;
esac # End of vendorprefix != ''
fi
;;
esac
eval val="\$$var"
if test X"$val" = X"$dflt"; then
echo "# $var='$dflt'"
else
echo "# Preserving custom $var"
echo "$var='$val'"
fi
done >> Policy.sh
$spitshell <<!GROK!THIS! >>Policy.sh
# Lastly, you may add additional items here. For example, to set the
# pager to your local favorite value, uncomment the following line in
# the original Policy_sh.SH file and re-run sh Policy_sh.SH.
#
# pager='$pager'
#
# A full Glossary of all the config.sh variables is in the file
# Porting/Glossary.
!GROK!THIS!
#Credits:
# The original design for this Policy.sh file came from Wayne Davison,
# maintainer of trn.
# This version for Perl5.004_61 originally written by
# Andy Dougherty <doughera at lafayette.edu>.
# This file may be distributed under the same terms as Perl itself.
--- NEW FILE: numeric.c ---
/* numeric.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "That only makes eleven (plus one mislaid) and not fourteen, unless
* wizards count differently to other people."
*/
/*
=head1 Numeric functions
This file contains all the stuff needed by perl for manipulating numeric
[...1004 lines suppressed...]
}
#endif
#if ! defined(HAS_FREXPL) && defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
long double
Perl_my_frexpl(long double x, int *e) {
*e = x == 0.0L ? 0 : ilogbl(x) + 1;
return (scalbnl(x, -*e));
}
#endif
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perly.c ---
#ifndef lint
/* static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; */
#endif
#define YYBYACC 1
#line 25 "perly.y"
#include "EXTERN.h"
#define PERL_IN_PERLY_C
#include "perl.h"
#ifdef EBCDIC
#undef YYDEBUG
#endif
#define dep() deprecate_old("\"do\" to call subroutines")
/* stuff included here to make perly_c.diff apply better */
#define yydebug PL_yydebug
#define yynerrs PL_yynerrs
#define yyerrflag PL_yyerrflag
#define yychar PL_yychar
[...2517 lines suppressed...]
if (ysave->yyss) Safefree(ysave->yyss);
if (ysave->yyvs) Safefree(ysave->yyvs);
yydebug = ysave->oldyydebug;
yynerrs = ysave->oldyynerrs;
yyerrflag = ysave->oldyyerrflag;
yychar = ysave->oldyychar;
yyval = ysave->oldyyval;
yylval = ysave->oldyylval;
Safefree(ysave);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perlsh ---
#!/usr/bin/perl
# Poor man's perl shell.
# Simply type two carriage returns every time you want to evaluate.
# Note that it must be a complete perl statement--don't type double
# carriage return in the middle of a loop.
$/ = "\n\n"; # set paragraph mode
$SHlinesep = "\n";
while (defined($SHcmd = <>)) {
$/ = $SHlinesep;
eval $SHcmd; print $@ || "\n";
$SHlinesep = $/; $/ = '';
}
--- NEW FILE: iperlsys.h ---
/*
* iperlsys.h - Perl's interface to the system
*
* This file defines the system level functionality that perl needs.
*
* When using C, this definition is in the form of a set of macros
* that can be #defined to the system-level function (or a wrapper
* provided elsewhere).
*
* GSAR 21-JUN-98
*/
#ifndef __Inc__IPerl___
#define __Inc__IPerl___
/*
* PerlXXX_YYY explained - DickH and DougL @ ActiveState.com
*
* XXX := functional group
[...1368 lines suppressed...]
#define PerlSock_sendto(s, b, l, f, t, tlen) \
sendto(s, b, l, f, t, tlen)
#define PerlSock_sethostent(f) sethostent(f)
#define PerlSock_setnetent(f) setnetent(f)
#define PerlSock_setprotoent(f) setprotoent(f)
#define PerlSock_setservent(f) setservent(f)
#define PerlSock_setsockopt(s, l, n, v, len) \
setsockopt(s, l, n, v, len)
#define PerlSock_shutdown(s, h) shutdown(s, h)
#define PerlSock_socket(a, t, p) socket(a, t, p)
#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f)
#ifdef WIN32
#define PerlSock_closesocket(s) closesocket(s)
#endif
#endif /* PERL_IMPLICIT_SYS */
#endif /* __Inc__IPerl___ */
--- NEW FILE: pp_ctl.c ---
/* pp_ctl.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Now far ahead the Road has gone,
* And I must follow, if I can,
* Pursuing it with eager feet,
* Until it joins some larger way
* Where many paths and errands meet.
* And whither then? I cannot say.
*/
[...3974 lines suppressed...]
#else
|| (*name == '.' && (name[1] == '/' ||
(name[1] == '.' && name[2] == '/'))))
#endif
{
return TRUE;
}
else
return FALSE;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: perly.h ---
#ifdef PERL_CORE
#define WORD 257
#define METHOD 258
#define FUNCMETH 259
#define THING 260
#define PMFUNC 261
#define PRIVATEREF 262
#define FUNC0SUB 263
#define UNIOPSUB 264
#define LSTOPSUB 265
#define LABEL 266
#define FORMAT 267
#define SUB 268
#define ANONSUB 269
#define PACKAGE 270
#define USE 271
#define WHILE 272
#define UNTIL 273
#define IF 274
#define UNLESS 275
#define ELSE 276
#define ELSIF 277
#define CONTINUE 278
#define FOR 279
#define LOOPEX 280
#define DOTDOT 281
#define FUNC0 282
#define FUNC1 283
#define FUNC 284
#define UNIOP 285
#define LSTOP 286
#define RELOP 287
#define EQOP 288
#define MULOP 289
#define ADDOP 290
#define DOLSHARP 291
#define DO 292
#define HASHBRACK 293
#define NOAMP 294
#define LOCAL 295
#define MY 296
#define MYSUB 297
#define COLONATTR 298
#define PREC_LOW 299
#define OROP 300
#define ANDOP 301
#define NOTOP 302
#define ASSIGNOP 303
#define OROR 304
#define ANDAND 305
#define BITOROP 306
#define BITANDOP 307
#define SHIFTOP 308
#define MATCHOP 309
#define UMINUS 310
#define REFGEN 311
#define POWOP 312
#define PREINC 313
#define PREDEC 314
#define POSTINC 315
#define POSTDEC 316
#define ARROW 317
#endif /* PERL_CORE */
typedef union {
I32 ival;
char *pval;
OP *opval;
GV *gvval;
} YYSTYPE;
--- NEW FILE: configpm ---
#!./miniperl -w
use strict;
use vars qw(%Config $Config_SH_expanded);
my $how_many_common = 22;
# commonly used names to precache (and hence lookup fastest)
my %Common;
while ($how_many_common--) {
$_ = <DATA>;
chomp;
/^(\S+):\s*(\d+)$/ or die "Malformed line '$_'";
$Common{$1} = $1;
}
# names of things which may need to have slashes changed to double-colons
my %Extensions = map {($_,$_)}
qw(dynamic_ext static_ext extensions known_extensions);
# allowed opts as well as specifies default and initial values
my %Allowed_Opts = (
'cross' => '', # --cross=PLATFORM - crosscompiling for PLATFORM
'glossary' => 1, # --no-glossary - no glossary file inclusion,
# for compactness
'heavy' => '', # pathname of the Config_heavy.pl file
);
sub opts {
# user specified options
my %given_opts = (
# --opt=smth
(map {/^--([\-_\w]+)=(.*)$/} @ARGV),
# --opt --no-opt --noopt
(map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),
);
my %opts = (%Allowed_Opts, %given_opts);
for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) {
die "option '$opt' is not recognized";
}
@ARGV = grep {!/^--/} @ARGV;
return %opts;
}
my %Opts = opts();
my ($Config_PM, $Config_heavy);
my $Glossary = $ARGV[1] || 'Porting/Glossary';
if ($Opts{cross}) {
# creating cross-platform config file
mkdir "xlib";
mkdir "xlib/$Opts{cross}";
$Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
}
else {
$Config_PM = $ARGV[0] || 'lib/Config.pm';
}
if ($Opts{heavy}) {
$Config_heavy = $Opts{heavy};
}
else {
($Config_heavy = $Config_PM) =~ s!\.pm$!_heavy.pl!;
die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
if $Config_heavy eq $Config_PM;
}
open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n";
open CONFIG_HEAVY, ">$Config_heavy" or die "Can't open $Config_heavy: $!\n";
print CONFIG_HEAVY <<'ENDOFBEG';
# This file was created by configpm when Perl was built. Any changes
# made to this file will be lost the next time perl is built.
package Config;
use strict;
# use warnings; Pulls in Carp
# use vars pulls in Carp
ENDOFBEG
my $myver = sprintf "v%vd", $^V;
printf CONFIG <<'ENDOFBEG', ($myver) x 3;
# This file was created by configpm when Perl was built. Any changes
# made to this file will be lost the next time perl is built.
package Config;
use strict;
# use warnings; Pulls in Carp
# use vars pulls in Carp
@Config::EXPORT = qw(%%Config);
@Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re);
# Need to stub all the functions to make code such as print Config::config_sh
# keep working
sub myconfig;
sub config_sh;
sub config_vars;
sub config_re;
my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
our %%Config;
# Define our own import method to avoid pulling in the full Exporter:
sub import {
my $pkg = shift;
@_ = @Config::EXPORT unless @_;
my @funcs = grep $_ ne '%%Config', @_;
my $export_Config = @funcs < @_ ? 1 : 0;
no strict 'refs';
my $callpkg = caller(0);
foreach my $func (@funcs) {
die sprintf qq{"%%s" is not exported by the %%s module\n},
$func, __PACKAGE__ unless $Export_Cache{$func};
*{$callpkg.'::'.$func} = \&{$func};
}
*{"$callpkg\::Config"} = \%%Config if $export_Config;
return;
}
die "Perl lib version (%s) doesn't match executable version ($])"
unless $^V;
$^V eq %s
or die "Perl lib version (%s) doesn't match executable version (" .
sprintf("v%%vd",$^V) . ")";
ENDOFBEG
my @non_v = ();
my @v_others = ();
my $in_v = 0;
my %Data = ();
my %seen_quotes;
{
my ($name, $val);
open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
while (<CONFIG_SH>) {
next if m:^#!/bin/sh:;
# Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/;
my($k, $v) = ($1, $2);
# grandfather PATCHLEVEL and SUBVERSION and CONFIG
if ($k) {
if ($k eq 'PERL_VERSION') {
push @v_others, "PATCHLEVEL='$v'\n";
}
elsif ($k eq 'PERL_SUBVERSION') {
push @v_others, "SUBVERSION='$v'\n";
}
elsif ($k eq 'PERL_CONFIG_SH') {
push @v_others, "CONFIG='$v'\n";
}
}
# We can delimit things in config.sh with either ' or ".
unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
push(@non_v, "#$_"); # not a name='value' line
next;
}
my $quote = $2;
if ($in_v) {
$val .= $_;
}
else {
($name,$val) = ($1,$3);
}
$in_v = $val !~ /$quote\n/;
next if $in_v;
s,/,::,g if $Extensions{$name};
$val =~ s/$quote\n?\z//;
my $line = "$name=$quote$val$quote\n";
push(@v_others, $line);
$seen_quotes{$quote}++;
}
close CONFIG_SH;
}
# This is somewhat grim, but I want the code for parsing config.sh here and
# now so that I can expand $Config{ivsize} and $Config{ivtype}
my $fetch_string = <<'EOT';
# Search for it in the big string
sub fetch_string {
my($self, $key) = @_;
EOT
if ($seen_quotes{'"'}) {
# We need the full ' and " code
$fetch_string .= <<'EOT';
my $quote_type = "'";
my $marker = "$key=";
# Check for the common case, ' delimited
my $start = index($Config_SH_expanded, "\n$marker$quote_type");
# If that failed, check for " delimited
if ($start == -1) {
$quote_type = '"';
$start = index($Config_SH_expanded, "\n$marker$quote_type");
}
EOT
} else {
$fetch_string .= <<'EOT';
# We only have ' delimted.
my $start = index($Config_SH_expanded, "\n$key=\'");
EOT
}
$fetch_string .= <<'EOT';
# Start can never be -1 now, as we've rigged the long string we're
# searching with an initial dummy newline.
return undef if $start == -1;
$start += length($key) + 3;
EOT
if (!$seen_quotes{'"'}) {
# Don't need the full ' and " code, or the eval expansion.
$fetch_string .= <<'EOT';
my $value = substr($Config_SH_expanded, $start,
index($Config_SH_expanded, "'\n", $start)
- $start);
EOT
} else {
$fetch_string .= <<'EOT';
my $value = substr($Config_SH_expanded, $start,
index($Config_SH_expanded, "$quote_type\n", $start)
- $start);
# If we had a double-quote, we'd better eval it so escape
# sequences and such can be interpolated. Since the incoming
# value is supposed to follow shell rules and not perl rules,
# we escape any perl variable markers
if ($quote_type eq '"') {
$value =~ s/\$/\\\$/g;
$value =~ s/\@/\\\@/g;
eval "\$value = \"$value\"";
}
EOT
}
$fetch_string .= <<'EOT';
# So we can say "if $Config{'foo'}".
$value = undef if $value eq 'undef';
$self->{$key} = $value; # cache it
}
EOT
eval $fetch_string;
die if $@;
# Calculation for the keys for byteorder
# This is somewhat grim, but I need to run fetch_string here.
our $Config_SH_expanded = join "\n", '', @v_others;
my $t = fetch_string ({}, 'ivtype');
my $s = fetch_string ({}, 'ivsize');
# byteorder does exist on its own but we overlay a virtual
# dynamically recomputed value.
# However, ivtype and ivsize will not vary for sane fat binaries
my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
my $byteorder_code;
if ($s == 4 || $s == 8) {
my $list = join ',', reverse(2..$s);
my $format = 'a'x$s;
$byteorder_code = <<"EOT";
my \$i = 0;
foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 }
\$i |= ord(1);
our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
EOT
} else {
$byteorder_code = "our \$byteorder = '?'x$s;\n";
}
print CONFIG_HEAVY @non_v, "\n";
# copy config summary format from the myconfig.SH script
print CONFIG_HEAVY "our \$summary = <<'!END!';\n";
open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { print CONFIG_HEAVY $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
close(MYCONFIG);
print CONFIG_HEAVY "\n!END!\n", <<'EOT';
my $summary_expanded;
sub myconfig {
return $summary_expanded if $summary_expanded;
($summary_expanded = $summary) =~ s{\$(\w+)}
{ my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
$summary_expanded;
}
local *_ = \my $a;
$_ = <<'!END!';
EOT
print CONFIG_HEAVY join('', sort @v_others), "!END!\n";
# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
# the precached keys
if ($Common{byteorder}) {
print CONFIG $byteorder_code;
} else {
print CONFIG_HEAVY $byteorder_code;
}
print CONFIG_HEAVY <<'EOT';
s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
my $config_sh_len = length $_;
our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
EOT
foreach my $prefix (qw(ccflags ldflags)) {
my $value = fetch_string ({}, $prefix);
my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
$value =~ s/\Q$withlargefiles\E\b//;
print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
}
foreach my $prefix (qw(libs libswanted)) {
my $value = fetch_string ({}, $prefix);
my @lflibswanted
= split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
if (@lflibswanted) {
my %lflibswanted;
@lflibswanted{@lflibswanted} = ();
if ($prefix eq 'libs') {
my @libs = grep { /^-l(.+)/ &&
not exists $lflibswanted{$1} }
split(' ', fetch_string ({}, 'libs'));
$value = join(' ', @libs);
} else {
my @libswanted = grep { not exists $lflibswanted{$_} }
split(' ', fetch_string ({}, 'libswanted'));
$value = join(' ', @libswanted);
}
}
print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
}
print CONFIG_HEAVY "EOVIRTUAL\n";
print CONFIG_HEAVY $fetch_string;
print CONFIG <<'ENDOFEND';
sub FETCH {
my($self, $key) = @_;
# check for cached value (which may be undef so we use exists not defined)
return $self->{$key} if exists $self->{$key};
return $self->fetch_string($key);
}
ENDOFEND
print CONFIG_HEAVY <<'ENDOFEND';
my $prevpos = 0;
sub FIRSTKEY {
$prevpos = 0;
substr($Config_SH_expanded, 1, index($Config_SH_expanded, '=') - 1 );
}
sub NEXTKEY {
ENDOFEND
if ($seen_quotes{'"'}) {
print CONFIG_HEAVY <<'ENDOFEND';
# Find out how the current key's quoted so we can skip to its end.
my $quote = substr($Config_SH_expanded,
index($Config_SH_expanded, "=", $prevpos)+1, 1);
my $pos = index($Config_SH_expanded, qq($quote\n), $prevpos) + 2;
ENDOFEND
} else {
# Just ' quotes, so it's much easier.
print CONFIG_HEAVY <<'ENDOFEND';
my $pos = index($Config_SH_expanded, qq('\n), $prevpos) + 2;
ENDOFEND
}
print CONFIG_HEAVY <<'ENDOFEND';
my $len = index($Config_SH_expanded, "=", $pos) - $pos;
$prevpos = $pos;
$len > 0 ? substr($Config_SH_expanded, $pos, $len) : undef;
}
sub EXISTS {
return 1 if exists($_[0]->{$_[1]});
return(index($Config_SH_expanded, "\n$_[1]='") != -1
ENDOFEND
if ($seen_quotes{'"'}) {
print CONFIG_HEAVY <<'ENDOFEND';
or index($Config_SH_expanded, "\n$_[1]=\"") != -1
ENDOFEND
}
print CONFIG_HEAVY <<'ENDOFEND';
);
}
sub STORE { die "\%Config::Config is read-only\n" }
*DELETE = \&STORE;
*CLEAR = \&STORE;
sub config_sh {
substr $Config_SH_expanded, 1, $config_sh_len;
}
sub config_re {
my $re = shift;
return map { chomp; $_ } grep eval{ /^(?:$re)=/ }, split /^/,
$Config_SH_expanded;
}
sub config_vars {
# implements -V:cfgvar option (see perlrun -V:)
foreach (@_) {
# find optional leading, trailing colons; and query-spec
my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft,
# map colon-flags to print decorations
my $prfx = $notag ? '': "$qry="; # tag-prefix for print
my $lnend = $lncont ? ' ' : ";\n"; # line ending for print
# all config-vars are by definition \w only, any \W means regex
if ($qry =~ /\W/) {
my @matches = config_re($qry);
print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag;
print map { s/\w+=//; "$_$lnend" } @matches ? @matches : "$qry: not found" if $notag;
} else {
my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
: 'UNKNOWN';
$v = 'undef' unless defined $v;
print "${prfx}'${v}'$lnend";
}
}
}
# Called by the real AUTOLOAD
sub launcher {
undef &AUTOLOAD;
goto \&$Config::AUTOLOAD;
}
1;
ENDOFEND
if ($^O eq 'os2') {
print CONFIG <<'ENDOFSET';
my %preconfig;
if ($OS2::is_aout) {
my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
for (split ' ', $value) {
($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
$preconfig{$_} = $v eq 'undef' ? undef : $v;
}
}
$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
sub TIEHASH { bless {%preconfig} }
ENDOFSET
# Extract the name of the DLL from the makefile to avoid duplication
my ($f) = grep -r, qw(GNUMakefile Makefile);
my $dll;
if (open my $fh, '<', $f) {
while (<$fh>) {
$dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
}
}
print CONFIG <<ENDOFSET if $dll;
\$preconfig{dll_name} = '$dll';
ENDOFSET
} else {
print CONFIG <<'ENDOFSET';
sub TIEHASH {
bless $_[1], $_[0];
}
ENDOFSET
}
foreach my $key (keys %Common) {
my $value = fetch_string ({}, $key);
# Is it safe on the LHS of => ?
my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
if (defined $value) {
# Quote things for a '' string
$value =~ s!\\!\\\\!g;
$value =~ s!'!\\'!g;
$value = "'$value'";
} else {
$value = "undef";
}
$Common{$key} = "$qkey => $value";
}
if ($Common{byteorder}) {
$Common{byteorder} = 'byteorder => $byteorder';
}
my $fast_config = join '', map { " $_,\n" } sort values %Common;
# Sanity check needed to stop an infite loop if Config_heavy.pl fails to define
# &launcher for some reason (eg it got truncated)
print CONFIG sprintf <<'ENDOFTIE', $fast_config;
sub DESTROY { }
sub AUTOLOAD {
require 'Config_heavy.pl';
goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
}
# tie returns the object, so the value returned to require will be true.
tie %%Config, 'Config', {
%s};
ENDOFTIE
open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
print CONFIG_POD <<'ENDOFTAIL';
=head1 NAME
Config - access Perl configuration information
=head1 SYNOPSIS
use Config;
if ($Config{usethreads}) {
print "has thread support\n"
}
use Config qw(myconfig config_sh config_vars config_re);
print myconfig();
print config_sh();
print config_re();
config_vars(qw(osname archname));
=head1 DESCRIPTION
The Config module contains all the information that was available to
the C<Configure> program at Perl build time (over 900 values).
Shell variables from the F<config.sh> file (written by Configure) are
stored in the readonly-variable C<%Config>, indexed by their names.
Values stored in config.sh as 'undef' are returned as undefined
values. The perl C<exists> function can be used to check if a
named variable exists.
=over 4
=item myconfig()
Returns a textual summary of the major perl configuration values.
See also C<-V> in L<perlrun/Switches>.
=item config_sh()
Returns the entire perl configuration information in the form of the
original config.sh shell variable assignment script.
=item config_re($regex)
Like config_sh() but returns, as a list, only the config entries who's
names match the $regex.
=item config_vars(@names)
Prints to STDOUT the values of the named configuration variable. Each is
printed on a separate line in the form:
name='value';
Names which are unknown are output as C<name='UNKNOWN';>.
See also C<-V:name> in L<perlrun/Switches>.
=back
=head1 EXAMPLE
Here's a more sophisticated example of using %Config:
use Config;
use strict;
my %sig_num;
my @sig_name;
unless($Config{sig_name} && $Config{sig_num}) {
die "No sigs?";
} else {
my @names = split ' ', $Config{sig_name};
@sig_num{@names} = split ' ', $Config{sig_num};
foreach (@names) {
$sig_name[$sig_num{$_}] ||= $_;
}
}
print "signal #17 = $sig_name[17]\n";
if ($sig_num{ALRM}) {
print "SIGALRM is $sig_num{ALRM}\n";
}
=head1 WARNING
Because this information is not stored within the perl executable
itself it is possible (but unlikely) that the information does not
relate to the actual perl binary which is being used to access it.
The Config module is installed into the architecture and version
specific library directory ($Config{installarchlib}) and it checks the
perl version number when loaded.
The values stored in config.sh may be either single-quoted or
double-quoted. Double-quoted strings are handy for those cases where you
need to include escape sequences in the strings. To avoid runtime variable
interpolation, any C<$> and C<@> characters are replaced by C<\$> and
C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
or C<\@> in double-quoted strings unless you're willing to deal with the
consequences. (The slashes will end up escaped and the C<$> or C<@> will
trigger variable interpolation)
=head1 GLOSSARY
Most C<Config> variables are determined by the C<Configure> script
on platforms supported by it (which is most UNIX platforms). Some
platforms have custom-made C<Config> variables, and may thus not have
some of the variables described below, or may have extraneous variables
specific to that particular port. See the port specific documentation
in such cases.
ENDOFTAIL
if ($Opts{glossary}) {
open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!";
}
my %seen = ();
my $text = 0;
$/ = '';
sub process {
if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
my $c = substr $1, 0, 1;
unless ($seen{$c}++) {
print CONFIG_POD <<EOF if $text;
=back
EOF
print CONFIG_POD <<EOF;
=head2 $c
=over 4
EOF
$text = 1;
}
}
elsif (!$text || !/\A\t/) {
warn "Expected a Configure variable header",
($text ? " or another paragraph of description" : () );
}
s/n't/n\00t/g; # leave can't, won't etc untouched
s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
s{
(?<! [\w./<\'\"] ) # Only standalone file names
(?! e \. g \. ) # Not e.g.
(?! \. \. \. ) # Not ...
(?! \d ) # Not 5.004
(?! read/ ) # Not read/write
(?! etc\. ) # Not etc.
(?! I/O ) # Not I/O
(
\$ ? # Allow leading $
[\w./]* [./] [\w./]* # Require . or / inside
)
(?<! \. (?= [\s)] ) ) # Do not include trailing dot
(?! [\w/] ) # Include all of it
}
(F<$1>)xg; # /usr/local
s/((?<=\s)~\w*)/F<$1>/g; # ~name
s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
s/n[\0]t/n't/g; # undo can't, won't damage
}
if ($Opts{glossary}) {
<GLOS>; # Skip the "DO NOT EDIT"
<GLOS>; # Skip the preamble
while (<GLOS>) {
process;
print CONFIG_POD;
}
}
print CONFIG_POD <<'ENDOFTAIL';
=back
=head1 NOTE
This module contains a good example of how to use tie to implement a
cache and an example of how to make a tied variable readonly to those
outside of it.
=cut
ENDOFTAIL
close(CONFIG_HEAVY);
close(CONFIG);
close(GLOS);
close(CONFIG_POD);
# Now create Cross.pm if needed
if ($Opts{cross}) {
open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
my $cross = <<'EOS';
# typical invocation:
# perl -MCross Makefile.PL
# perl -MCross=wince -V:cc
package Cross;
sub import {
my ($package,$platform) = @_;
unless (defined $platform) {
# if $platform is not specified, then use last one when
# 'configpm; was invoked with --cross option
$platform = '***replace-marker***';
}
@INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
$::Cross::platform = $platform;
}
1;
EOS
$cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g;
print CROSS $cross;
close CROSS;
}
# Now do some simple tests on the Config.pm file we have created
unshift(@INC,'lib');
require $Config_PM;
require $Config_heavy;
import Config;
die "$0: $Config_PM not valid"
unless $Config{'PERL_CONFIG_SH'} eq 'true';
die "$0: error processing $Config_PM"
if defined($Config{'an impossible name'})
or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
;
die "$0: error processing $Config_PM"
if eval '$Config{"cc"} = 1'
or eval 'delete $Config{"cc"}'
;
exit 0;
# Popularity of various entries in %Config, based on a large build and test
# run of code in the Fotango build system:
__DATA__
path_sep: 8490
d_readlink: 7101
d_symlink: 7101
archlibexp: 4318
sitearchexp: 4305
sitelibexp: 4305
privlibexp: 4163
ldlibpthname: 4041
libpth: 2134
archname: 1591
exe_ext: 1256
scriptdir: 1155
version: 1116
useithreads: 1002
osvers: 982
osname: 851
inc_version_list: 783
dont_use_nlink: 779
intsize: 759
usevendorprefix: 642
dlsrc: 624
cc: 541
lib_ext: 520
so: 512
ld: 501
ccdlflags: 500
ldflags: 495
obj_ext: 495
cccdlflags: 493
lddlflags: 493
ar: 492
dlext: 492
libc: 492
ranlib: 492
full_ar: 491
vendorarchexp: 491
vendorlibexp: 491
installman1dir: 489
installman3dir: 489
installsitebin: 489
installsiteman1dir: 489
installsiteman3dir: 489
installvendorman1dir: 489
installvendorman3dir: 489
d_flexfnam: 474
eunicefix: 360
d_link: 347
installsitearch: 344
installscript: 341
installprivlib: 337
binexp: 336
installarchlib: 336
installprefixexp: 336
installsitelib: 336
installstyle: 336
installvendorarch: 336
installvendorbin: 336
installvendorlib: 336
man1ext: 336
man3ext: 336
sh: 336
siteprefixexp: 336
installbin: 335
usedl: 332
ccflags: 285
startperl: 232
optimize: 231
usemymalloc: 229
cpprun: 228
sharpbang: 228
perllibs: 225
usesfio: 224
usethreads: 220
perlpath: 218
extensions: 217
usesocks: 208
shellflags: 198
make: 191
d_pwage: 189
d_pwchange: 189
d_pwclass: 189
d_pwcomment: 189
d_pwexpire: 189
d_pwgecos: 189
d_pwpasswd: 189
d_pwquota: 189
gccversion: 189
libs: 186
useshrplib: 186
cppflags: 185
ptrsize: 185
shrpenv: 185
static_ext: 185
use5005threads: 185
uselargefiles: 185
alignbytes: 184
byteorder: 184
ccversion: 184
config_args: 184
cppminus: 184
--- NEW FILE: reentr.c ---
/* -*- buffer-read-only: t -*-
*
* reentr.c
*
* Copyright (C) 2002, 2003, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by reentr.pl from data in reentr.pl.
*
* "Saruman," I said, standing away from him, "only one hand at a time can
* wield the One, and you know that well, so do not trouble to say we!"
*
* This file contains a collection of automatically created wrappers
* (created by running reentr.pl) for reentrant (thread-safe) versions of
* various library calls, such as getpwent_r. The wrapping is done so
* that other files like pp_sys.c calling those library functions need not
* care about the differences between various platforms' idiosyncrasies
* regarding these reentrant interfaces.
*/
#include "EXTERN.h"
#define PERL_IN_REENTR_C
#include "perl.h"
#include "reentr.h"
void
Perl_reentrant_size(pTHX) {
#ifdef USE_REENTRANT_API
#define REENTRANTSMALLSIZE 256 /* Make something up. */
#define REENTRANTUSUALSIZE 4096 /* Make something up. */
#ifdef HAS_ASCTIME_R
PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
#endif /* HAS_ASCTIME_R */
#ifdef HAS_CRYPT_R
#endif /* HAS_CRYPT_R */
#ifdef HAS_CTIME_R
PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
#endif /* HAS_CTIME_R */
#ifdef HAS_DRAND48_R
#endif /* HAS_DRAND48_R */
#ifdef HAS_GETGRNAM_R
# if defined(HAS_SYSCONF) && defined(_SC_GETGR_R_SIZE_MAX) && !defined(__GLIBC__)
PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX);
if (PL_reentrant_buffer->_grent_size == -1)
PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
# else
# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
PL_reentrant_buffer->_grent_size = SIABUFSIZ;
# else
# ifdef __sgi
PL_reentrant_buffer->_grent_size = BUFSIZ;
# else
PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
# endif
# endif
# endif
#endif /* HAS_GETGRNAM_R */
#ifdef HAS_GETHOSTBYNAME_R
#if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE;
#endif
#endif /* HAS_GETHOSTBYNAME_R */
#ifdef HAS_GETLOGIN_R
PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE;
#endif /* HAS_GETLOGIN_R */
#ifdef HAS_GETNETBYNAME_R
#if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE;
#endif
#endif /* HAS_GETNETBYNAME_R */
#ifdef HAS_GETPROTOBYNAME_R
#if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE;
#endif
#endif /* HAS_GETPROTOBYNAME_R */
#ifdef HAS_GETPWNAM_R
# if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
if (PL_reentrant_buffer->_pwent_size == -1)
PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
# else
# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
PL_reentrant_buffer->_pwent_size = SIABUFSIZ;
# else
# ifdef __sgi
PL_reentrant_buffer->_pwent_size = BUFSIZ;
# else
PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
# endif
# endif
# endif
#endif /* HAS_GETPWNAM_R */
#ifdef HAS_GETSERVBYNAME_R
#if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE;
#endif
#endif /* HAS_GETSERVBYNAME_R */
#ifdef HAS_GETSPNAM_R
# if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
if (PL_reentrant_buffer->_spent_size == -1)
PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
# else
# if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
PL_reentrant_buffer->_spent_size = SIABUFSIZ;
# else
# ifdef __sgi
PL_reentrant_buffer->_spent_size = BUFSIZ;
# else
PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
# endif
# endif
# endif
#endif /* HAS_GETSPNAM_R */
#ifdef HAS_GMTIME_R
#endif /* HAS_GMTIME_R */
#ifdef HAS_LOCALTIME_R
#endif /* HAS_LOCALTIME_R */
#ifdef HAS_RANDOM_R
#endif /* HAS_RANDOM_R */
#ifdef HAS_READDIR_R
/* This is the size Solaris recommends.
* (though we go static, should use pathconf() instead) */
PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1;
#endif /* HAS_READDIR_R */
#ifdef HAS_READDIR64_R
/* This is the size Solaris recommends.
* (though we go static, should use pathconf() instead) */
PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1;
#endif /* HAS_READDIR64_R */
#ifdef HAS_SETLOCALE_R
PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE;
#endif /* HAS_SETLOCALE_R */
#ifdef HAS_STRERROR_R
PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE;
#endif /* HAS_STRERROR_R */
#ifdef HAS_TTYNAME_R
PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE;
#endif /* HAS_TTYNAME_R */
#endif /* USE_REENTRANT_API */
}
void
Perl_reentrant_init(pTHX) {
#ifdef USE_REENTRANT_API
Newx(PL_reentrant_buffer, 1, REENTR);
Perl_reentrant_size(aTHX);
#ifdef HAS_ASCTIME_R
Newx(PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char);
#endif /* HAS_ASCTIME_R */
#ifdef HAS_CRYPT_R
#if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
PL_reentrant_buffer->_crypt_struct_buffer = 0;
#endif
#endif /* HAS_CRYPT_R */
#ifdef HAS_CTIME_R
Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char);
#endif /* HAS_CTIME_R */
#ifdef HAS_DRAND48_R
#endif /* HAS_DRAND48_R */
#ifdef HAS_GETGRNAM_R
# ifdef USE_GRENT_FPTR
PL_reentrant_buffer->_grent_fptr = NULL;
# endif
Newx(PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char);
#endif /* HAS_GETGRNAM_R */
#ifdef HAS_GETHOSTBYNAME_R
#if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Newx(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char);
#endif
#endif /* HAS_GETHOSTBYNAME_R */
#ifdef HAS_GETLOGIN_R
Newx(PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char);
#endif /* HAS_GETLOGIN_R */
#ifdef HAS_GETNETBYNAME_R
#if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Newx(PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char);
#endif
#endif /* HAS_GETNETBYNAME_R */
#ifdef HAS_GETPROTOBYNAME_R
#if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Newx(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char);
#endif
#endif /* HAS_GETPROTOBYNAME_R */
#ifdef HAS_GETPWNAM_R
# ifdef USE_PWENT_FPTR
PL_reentrant_buffer->_pwent_fptr = NULL;
# endif
Newx(PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char);
#endif /* HAS_GETPWNAM_R */
#ifdef HAS_GETSERVBYNAME_R
#if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
Newx(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char);
#endif
#endif /* HAS_GETSERVBYNAME_R */
#ifdef HAS_GETSPNAM_R
# ifdef USE_SPENT_FPTR
PL_reentrant_buffer->_spent_fptr = NULL;
# endif
Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char);
#endif /* HAS_GETSPNAM_R */
#ifdef HAS_GMTIME_R
#endif /* HAS_GMTIME_R */
#ifdef HAS_LOCALTIME_R
#endif /* HAS_LOCALTIME_R */
#ifdef HAS_RANDOM_R
#endif /* HAS_RANDOM_R */
#ifdef HAS_READDIR_R
PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size);
#endif /* HAS_READDIR_R */
#ifdef HAS_READDIR64_R
PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size);
#endif /* HAS_READDIR64_R */
#ifdef HAS_SETLOCALE_R
Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char);
#endif /* HAS_SETLOCALE_R */
#ifdef HAS_STRERROR_R
Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char);
#endif /* HAS_STRERROR_R */
#ifdef HAS_TTYNAME_R
Newx(PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char);
#endif /* HAS_TTYNAME_R */
#endif /* USE_REENTRANT_API */
}
void
Perl_reentrant_free(pTHX) {
#ifdef USE_REENTRANT_API
#ifdef HAS_ASCTIME_R
Safefree(PL_reentrant_buffer->_asctime_buffer);
#endif /* HAS_ASCTIME_R */
#ifdef HAS_CRYPT_R
#if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
Safefree(PL_reentrant_buffer->_crypt_struct_buffer);
#endif
#endif /* HAS_CRYPT_R */
#ifdef HAS_CTIME_R
Safefree(PL_reentrant_buffer->_ctime_buffer);
#endif /* HAS_CTIME_R */
#ifdef HAS_DRAND48_R
#endif /* HAS_DRAND48_R */
#ifdef HAS_GETGRNAM_R
Safefree(PL_reentrant_buffer->_grent_buffer);
#endif /* HAS_GETGRNAM_R */
#ifdef HAS_GETHOSTBYNAME_R
#if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Safefree(PL_reentrant_buffer->_hostent_buffer);
#endif
#endif /* HAS_GETHOSTBYNAME_R */
#ifdef HAS_GETLOGIN_R
Safefree(PL_reentrant_buffer->_getlogin_buffer);
#endif /* HAS_GETLOGIN_R */
#ifdef HAS_GETNETBYNAME_R
#if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Safefree(PL_reentrant_buffer->_netent_buffer);
#endif
#endif /* HAS_GETNETBYNAME_R */
#ifdef HAS_GETPROTOBYNAME_R
#if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
Safefree(PL_reentrant_buffer->_protoent_buffer);
#endif
#endif /* HAS_GETPROTOBYNAME_R */
#ifdef HAS_GETPWNAM_R
Safefree(PL_reentrant_buffer->_pwent_buffer);
#endif /* HAS_GETPWNAM_R */
#ifdef HAS_GETSERVBYNAME_R
#if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
Safefree(PL_reentrant_buffer->_servent_buffer);
#endif
#endif /* HAS_GETSERVBYNAME_R */
#ifdef HAS_GETSPNAM_R
Safefree(PL_reentrant_buffer->_spent_buffer);
#endif /* HAS_GETSPNAM_R */
#ifdef HAS_GMTIME_R
#endif /* HAS_GMTIME_R */
#ifdef HAS_LOCALTIME_R
#endif /* HAS_LOCALTIME_R */
#ifdef HAS_RANDOM_R
#endif /* HAS_RANDOM_R */
#ifdef HAS_READDIR_R
Safefree(PL_reentrant_buffer->_readdir_struct);
#endif /* HAS_READDIR_R */
#ifdef HAS_READDIR64_R
Safefree(PL_reentrant_buffer->_readdir64_struct);
#endif /* HAS_READDIR64_R */
#ifdef HAS_SETLOCALE_R
Safefree(PL_reentrant_buffer->_setlocale_buffer);
#endif /* HAS_SETLOCALE_R */
#ifdef HAS_STRERROR_R
Safefree(PL_reentrant_buffer->_strerror_buffer);
#endif /* HAS_STRERROR_R */
#ifdef HAS_TTYNAME_R
Safefree(PL_reentrant_buffer->_ttyname_buffer);
#endif /* HAS_TTYNAME_R */
Safefree(PL_reentrant_buffer);
#endif /* USE_REENTRANT_API */
}
void*
Perl_reentrant_retry(const char *f, ...)
{
dTHX;
void *retptr = NULL;
#ifdef USE_REENTRANT_API
# if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
void *p0;
# endif
# if defined(USE_SERVENT_BUFFER)
void *p1;
# endif
# if defined(USE_HOSTENT_BUFFER)
size_t asize;
# endif
# if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
int anint;
# endif
va_list ap;
va_start(ap, f);
switch (PL_op->op_type) {
#ifdef USE_HOSTENT_BUFFER
case OP_GHBYADDR:
case OP_GHBYNAME:
case OP_GHOSTENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_hostent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
PL_reentrant_buffer->_hostent_size *= 2;
Renew(PL_reentrant_buffer->_hostent_buffer,
PL_reentrant_buffer->_hostent_size, char);
switch (PL_op->op_type) {
case OP_GHBYADDR:
p0 = va_arg(ap, void *);
asize = va_arg(ap, size_t);
anint = va_arg(ap, int);
retptr = gethostbyaddr(p0, asize, anint); break;
case OP_GHBYNAME:
p0 = va_arg(ap, void *);
retptr = gethostbyname((char *)p0); break;
case OP_GHOSTENT:
retptr = gethostent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_GRENT_BUFFER
case OP_GGRNAM:
case OP_GGRGID:
case OP_GGRENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_grent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
Gid_t gid;
PL_reentrant_buffer->_grent_size *= 2;
Renew(PL_reentrant_buffer->_grent_buffer,
PL_reentrant_buffer->_grent_size, char);
switch (PL_op->op_type) {
case OP_GGRNAM:
p0 = va_arg(ap, void *);
retptr = getgrnam((char *)p0); break;
case OP_GGRGID:
#if Gid_t_size < INTSIZE
gid = (Gid_t)va_arg(ap, int);
#else
gid = va_arg(ap, Gid_t);
#endif
retptr = getgrgid(gid); break;
case OP_GGRENT:
retptr = getgrent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_NETENT_BUFFER
case OP_GNBYADDR:
case OP_GNBYNAME:
case OP_GNETENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_netent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
Netdb_net_t net;
PL_reentrant_buffer->_netent_size *= 2;
Renew(PL_reentrant_buffer->_netent_buffer,
PL_reentrant_buffer->_netent_size, char);
switch (PL_op->op_type) {
case OP_GNBYADDR:
net = va_arg(ap, Netdb_net_t);
anint = va_arg(ap, int);
retptr = getnetbyaddr(net, anint); break;
case OP_GNBYNAME:
p0 = va_arg(ap, void *);
retptr = getnetbyname((char *)p0); break;
case OP_GNETENT:
retptr = getnetent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_PWENT_BUFFER
case OP_GPWNAM:
case OP_GPWUID:
case OP_GPWENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_pwent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
Uid_t uid;
PL_reentrant_buffer->_pwent_size *= 2;
Renew(PL_reentrant_buffer->_pwent_buffer,
PL_reentrant_buffer->_pwent_size, char);
switch (PL_op->op_type) {
case OP_GPWNAM:
p0 = va_arg(ap, void *);
retptr = getpwnam((char *)p0); break;
case OP_GPWUID:
#if Uid_t_size < INTSIZE
uid = (Uid_t)va_arg(ap, int);
#else
uid = va_arg(ap, Uid_t);
#endif
retptr = getpwuid(uid); break;
case OP_GPWENT:
retptr = getpwent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_PROTOENT_BUFFER
case OP_GPBYNAME:
case OP_GPBYNUMBER:
case OP_GPROTOENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_protoent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
PL_reentrant_buffer->_protoent_size *= 2;
Renew(PL_reentrant_buffer->_protoent_buffer,
PL_reentrant_buffer->_protoent_size, char);
switch (PL_op->op_type) {
case OP_GPBYNAME:
p0 = va_arg(ap, void *);
retptr = getprotobyname((char *)p0); break;
case OP_GPBYNUMBER:
anint = va_arg(ap, int);
retptr = getprotobynumber(anint); break;
case OP_GPROTOENT:
retptr = getprotoent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
#ifdef USE_SERVENT_BUFFER
case OP_GSBYNAME:
case OP_GSBYPORT:
case OP_GSERVENT:
{
#ifdef PERL_REENTRANT_MAXSIZE
if (PL_reentrant_buffer->_servent_size <=
PERL_REENTRANT_MAXSIZE / 2)
#endif
{
PL_reentrant_buffer->_servent_size *= 2;
Renew(PL_reentrant_buffer->_servent_buffer,
PL_reentrant_buffer->_servent_size, char);
switch (PL_op->op_type) {
case OP_GSBYNAME:
p0 = va_arg(ap, void *);
p1 = va_arg(ap, void *);
retptr = getservbyname((char *)p0, (char *)p1); break;
case OP_GSBYPORT:
anint = va_arg(ap, int);
p0 = va_arg(ap, void *);
retptr = getservbyport(anint, (char *)p0); break;
case OP_GSERVENT:
retptr = getservent(); break;
default:
SETERRNO(ERANGE, LIB_INVARG);
break;
}
}
}
break;
#endif
default:
/* Not known how to retry, so just fail. */
break;
}
va_end(ap);
#endif
return retptr;
}
/* ex: set ro: */
--- NEW FILE: README.dos ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
perldos - Perl under DOS, W31, W95.
=head1 SYNOPSIS
These are instructions for building Perl under DOS (or w??), using
DJGPP v2.03 or later. Under w95 long filenames are supported.
=head1 DESCRIPTION
Before you start, you should glance through the README file
found in the top-level directory where the Perl distribution
was extracted. Make sure you read and understand the terms under
which this software is being distributed.
This port currently supports MakeMaker (the set of modules that
is used to build extensions to perl). Therefore, you should be
able to build and install most extensions found in the CPAN sites.
Detailed instructions on how to build and install perl extension
modules, including XS-type modules, is included. See 'BUILDING AND
INSTALLING MODULES'.
=head2 Prerequisites for Compiling Perl on DOS
=over 4
=item DJGPP
DJGPP is a port of GNU C/C++ compiler and development tools to 32-bit,
protected-mode environment on Intel 32-bit CPUs running MS-DOS and compatible
operating systems, by DJ Delorie <dj at delorie.com> and friends.
For more details (FAQ), check out the home of DJGPP at:
http://www.delorie.com/djgpp/
If you have questions about DJGPP, try posting to the DJGPP newsgroup:
comp.os.msdos.djgpp, or use the email gateway djgpp at delorie.com.
You can find the full DJGPP distribution on any SimTel.Net mirror all over
the world. Like:
ftp://ftp.simtel.net/pub/simtelnet/gnu/djgpp/v2*
You need the following files to build perl (or add new modules):
v2/djdev203.zip
v2gnu/bnu2112b.zip
v2gnu/gcc2953b.zip
v2gnu/bsh204b.zip
v2gnu/mak3791b.zip
v2gnu/fil40b.zip
v2gnu/sed3028b.zip
v2gnu/txt20b.zip
v2gnu/dif272b.zip
v2gnu/grep24b.zip
v2gnu/shl20jb.zip
v2gnu/gwk306b.zip
v2misc/csdpmi5b.zip
or possibly any newer version.
=item Pthreads
Thread support is not tested in this version of the djgpp perl.
=back
=head2 Shortcomings of Perl under DOS
Perl under DOS lacks some features of perl under UNIX because of
deficiencies in the UNIX-emulation, most notably:
=over 4
=item *
fork() and pipe()
=item *
some features of the UNIX filesystem regarding link count and file dates
=item *
in-place operation is a little bit broken with short filenames
=item *
sockets
=back
=head2 Building Perl on DOS
=over 4
=item *
Unpack the source package F<perl5.8*.tar.gz> with djtarx. If you want
to use long file names under w95 and also to get Perl to pass all its
tests, don't forget to use
set LFN=y
set FNCASE=y
before unpacking the archive.
=item *
Create a "symlink" or copy your bash.exe to sh.exe in your C<($DJDIR)/bin>
directory.
ln -s bash.exe sh.exe
[If you have the recommended version of bash for DJGPP, this is already
done for you.]
And make the C<SHELL> environment variable point to this F<sh.exe>:
set SHELL=c:/djgpp/bin/sh.exe (use full path name!)
You can do this in F<djgpp.env> too. Add this line BEFORE any section
definition:
+SHELL=%DJDIR%/bin/sh.exe
=item *
If you have F<split.exe> and F<gsplit.exe> in your path, then rename
F<split.exe> to F<djsplit.exe>, and F<gsplit.exe> to F<split.exe>.
Copy or link F<gecho.exe> to F<echo.exe> if you don't have F<echo.exe>.
Copy or link F<gawk.exe> to F<awk.exe> if you don't have F<awk.exe>.
[If you have the recommended versions of djdev, shell utilities and
gawk, all these are already done for you, and you will not need to do
anything.]
=item *
Chdir to the djgpp subdirectory of perl toplevel and type the following
commands:
set FNCASE=y
configure.bat
This will do some preprocessing then run the Configure script for you.
The Configure script is interactive, but in most cases you just need to
press ENTER. The "set" command ensures that DJGPP preserves the letter
case of file names when reading directories. If you already issued this
set command when unpacking the archive, and you are in the same DOS
session as when you unpacked the archive, you don't have to issue the
set command again. This command is necessary *before* you start to
(re)configure or (re)build perl in order to ensure both that perl builds
correctly and that building XS-type modules can succeed. See the DJGPP
info entry for "_preserve_fncase" for more information:
info libc alphabetical _preserve_fncase
If the script says that your package is incomplete, and asks whether
to continue, just answer with Y (this can only happen if you don't use
long filenames or forget to issue "set FNCASE=y" first).
When Configure asks about the extensions, I suggest IO and Fcntl,
and if you want database handling then SDBM_File or GDBM_File
(you need to install gdbm for this one). If you want to use the
POSIX extension (this is the default), make sure that the stack
size of your F<cc1.exe> is at least 512kbyte (you can check this
with: C<stubedit cc1.exe>).
You can use the Configure script in non-interactive mode too.
When I built my F<perl.exe>, I used something like this:
configure.bat -des
You can find more info about Configure's command line switches in
the F<INSTALL> file.
When the script ends, and you want to change some values in the
generated F<config.sh> file, then run
sh Configure -S
after you made your modifications.
IMPORTANT: if you use this C<-S> switch, be sure to delete the CONFIG
environment variable before running the script:
set CONFIG=
=item *
Now you can compile Perl. Type:
make
=back
=head2 Testing Perl on DOS
Type:
make test
If you're lucky you should see "All tests successful". But there can be
a few failed subtests (less than 5 hopefully) depending on some external
conditions (e.g. some subtests fail under linux/dosemu or plain dos
with short filenames only).
=head2 Installation of Perl on DOS
Type:
make install
This will copy the newly compiled perl and libraries into your DJGPP
directory structure. Perl.exe and the utilities go into C<($DJDIR)/bin>,
and the library goes under C<($DJDIR)/lib/perl5>. The pod documentation
goes under C<($DJDIR)/lib/perl5/pod>.
=head1 BUILDING AND INSTALLING MODULES ON DOS
=head2 Building Prerequisites for Perl on DOS
For building and installing non-XS modules, all you need is a working
perl under DJGPP. Non-XS modules do not require re-linking the perl
binary, and so are simpler to build and install.
XS-type modules do require re-linking the perl binary, because part of
an XS module is written in "C", and has to be linked together with the
perl binary to be executed. This is required because perl under DJGPP
is built with the "static link" option, due to the lack of "dynamic
linking" in the DJGPP environment.
Because XS modules require re-linking of the perl binary, you need both
the perl binary distribution and the perl source distribution to build
an XS extension module. In addition, you will have to have built your
perl binary from the source distribution so that all of the components
of the perl binary are available for the required link step.
=head2 Unpacking CPAN Modules on DOS
First, download the module package from CPAN (e.g., the "Comma Separated
Value" text package, Text-CSV-0.01.tar.gz). Then expand the contents of
the package into some location on your disk. Most CPAN modules are
built with an internal directory structure, so it is usually safe to
expand it in the root of your DJGPP installation. Some people prefer to
locate source trees under /usr/src (i.e., C<($DJDIR)/usr/src>), but you may
put it wherever seems most logical to you, *EXCEPT* under the same
directory as your perl source code. There are special rules that apply
to modules which live in the perl source tree that do not apply to most
of the modules in CPAN.
Unlike other DJGPP packages, which are normal "zip" files, most CPAN
module packages are "gzipped tarballs". Recent versions of WinZip will
safely unpack and expand them, *UNLESS* they have zero-length files. It
is a known WinZip bug (as of v7.0) that it will not extract zero-length
files.
>From the command line, you can use the djtar utility provided with DJGPP
to unpack and expand these files. For example:
C:\djgpp>djtarx -v Text-CSV-0.01.tar.gz
This will create the new directory C<($DJDIR)/Text-CSV-0.01>, filling
it with the source for this module.
=head2 Building Non-XS Modules on DOS
To build a non-XS module, you can use the standard module-building
instructions distributed with perl modules.
perl Makefile.PL
make
make test
make install
This is sufficient because non-XS modules install only ".pm" files and
(sometimes) pod and/or man documentation. No re-linking of the perl
binary is needed to build, install or use non-XS modules.
=head2 Building XS Modules on DOS
To build an XS module, you must use the standard module-building
instructions distributed with perl modules *PLUS* three extra
instructions specific to the DJGPP "static link" build environment.
set FNCASE=y
perl Makefile.PL
make
make perl
make test
make -f Makefile.aperl inst_perl MAP_TARGET=perl.exe
make install
The first extra instruction sets DJGPP's FNCASE environment variable so
that the new perl binary which you must build for an XS-type module will
build correctly. The second extra instruction re-builds the perl binary
in your module directory before you run "make test", so that you are
testing with the new module code you built with "make". The third extra
instruction installs the perl binary from your module directory into the
standard DJGPP binary directory, C<($DJDIR)/bin>, replacing your
previous perl binary.
Note that the MAP_TARGET value *must* have the ".exe" extension or you
will not create a "perl.exe" to replace the one in C<($DJDIR)/bin>.
When you are done, the XS-module install process will have added information
to your "perllocal" information telling that the perl binary has been replaced,
and what module was installed. You can view this information at any time
by using the command:
perl -S perldoc perllocal
=head1 AUTHOR
Laszlo Molnar, F<laszlo.molnar at eth.ericsson.se> [Installing/building perl]
Peter J. Farley III F<pjfarley at banet.net> [Building/installing modules]
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE: reentr.h ---
/* -*- buffer-read-only: t -*-
*
* reentr.h
*
* Copyright (C) 2002, 2003, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by reentr.pl from data in reentr.pl.
*/
#ifndef REENTR_H
#define REENTR_H
#ifdef USE_REENTRANT_API
#ifdef PERL_CORE
# define PL_REENTRANT_RETINT PL_reentrant_retint
#endif
/* Deprecations: some platforms have the said reentrant interfaces
* but they are declared obsolete and are not to be used. Often this
* means that the platform has threadsafed the interfaces (hopefully).
* All this is OS version dependent, so we are of course fooling ourselves.
* If you know of more deprecations on some platforms, please add your own. */
#ifdef __hpux
# undef HAS_CRYPT_R
# undef HAS_DRAND48_R
# undef HAS_ENDGRENT_R
# undef HAS_ENDPWENT_R
# undef HAS_GETGRENT_R
# undef HAS_GETPWENT_R
# undef HAS_SETLOCALE_R
# undef HAS_SRAND48_R
# undef HAS_STRERROR_R
# define NETDB_R_OBSOLETE
#endif
#if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
# undef HAS_CRYPT_R
# undef HAS_STRERROR_R
# define NETDB_R_OBSOLETE
#endif
#ifdef NETDB_R_OBSOLETE
# undef HAS_ENDHOSTENT_R
# undef HAS_ENDNETENT_R
# undef HAS_ENDPROTOENT_R
# undef HAS_ENDSERVENT_R
# undef HAS_GETHOSTBYADDR_R
# undef HAS_GETHOSTBYNAME_R
# undef HAS_GETHOSTENT_R
# undef HAS_GETNETBYADDR_R
# undef HAS_GETNETBYNAME_R
# undef HAS_GETNETENT_R
# undef HAS_GETPROTOBYNAME_R
# undef HAS_GETPROTOBYNUMBER_R
# undef HAS_GETPROTOENT_R
# undef HAS_GETSERVBYNAME_R
# undef HAS_GETSERVBYPORT_R
# undef HAS_GETSERVENT_R
# undef HAS_SETHOSTENT_R
# undef HAS_SETNETENT_R
# undef HAS_SETPROTOENT_R
# undef HAS_SETSERVENT_R
#endif
#ifdef I_PWD
# include <pwd.h>
#endif
#ifdef I_GRP
# include <grp.h>
#endif
#ifdef I_NETDB
# include <netdb.h>
#endif
#ifdef I_STDLIB
# include <stdlib.h> /* drand48_data */
#endif
#ifdef I_CRYPT
# ifdef I_CRYPT
# include <crypt.h>
# endif
#endif
#ifdef HAS_GETSPNAM_R
# ifdef I_SHADOW
# include <shadow.h>
# endif
#endif
#define REENTRANT_PROTO_B_B 1
#define REENTRANT_PROTO_B_BI 2
#define REENTRANT_PROTO_B_BW 3
#define REENTRANT_PROTO_B_CCD 4
#define REENTRANT_PROTO_B_CCS 5
#define REENTRANT_PROTO_B_IBI 6
#define REENTRANT_PROTO_B_IBW 7
#define REENTRANT_PROTO_B_SB 8
#define REENTRANT_PROTO_B_SBI 9
#define REENTRANT_PROTO_I_BI 10
#define REENTRANT_PROTO_I_BW 11
#define REENTRANT_PROTO_I_CCSBWR 12
#define REENTRANT_PROTO_I_CCSD 13
#define REENTRANT_PROTO_I_CII 14
#define REENTRANT_PROTO_I_CIISD 15
#define REENTRANT_PROTO_I_CSBI 16
#define REENTRANT_PROTO_I_CSBIR 17
#define REENTRANT_PROTO_I_CSBWR 18
#define REENTRANT_PROTO_I_CSBWRE 19
#define REENTRANT_PROTO_I_CSD 20
#define REENTRANT_PROTO_I_CWISBWRE 21
#define REENTRANT_PROTO_I_CWISD 22
#define REENTRANT_PROTO_I_D 23
#define REENTRANT_PROTO_I_H 24
#define REENTRANT_PROTO_I_IBI 25
#define REENTRANT_PROTO_I_IBW 26
#define REENTRANT_PROTO_I_ICBI 27
#define REENTRANT_PROTO_I_ICSBWR 28
#define REENTRANT_PROTO_I_ICSD 29
#define REENTRANT_PROTO_I_ID 30
#define REENTRANT_PROTO_I_IISD 31
#define REENTRANT_PROTO_I_ISBWR 32
#define REENTRANT_PROTO_I_ISD 33
#define REENTRANT_PROTO_I_LISBI 34
#define REENTRANT_PROTO_I_LISD 35
#define REENTRANT_PROTO_I_LS 36
#define REENTRANT_PROTO_I_SB 37
#define REENTRANT_PROTO_I_SBI 38
#define REENTRANT_PROTO_I_SBIE 39
#define REENTRANT_PROTO_I_SBIH 40
#define REENTRANT_PROTO_I_SBIR 41
#define REENTRANT_PROTO_I_SBWR 42
#define REENTRANT_PROTO_I_SBWRE 43
#define REENTRANT_PROTO_I_SD 44
#define REENTRANT_PROTO_I_ST 45
#define REENTRANT_PROTO_I_St 46
#define REENTRANT_PROTO_I_TISD 47
#define REENTRANT_PROTO_I_TS 48
#define REENTRANT_PROTO_I_TSBI 49
#define REENTRANT_PROTO_I_TSBIR 50
#define REENTRANT_PROTO_I_TSBWR 51
#define REENTRANT_PROTO_I_TSR 52
#define REENTRANT_PROTO_I_TsISBWRE 53
#define REENTRANT_PROTO_I_UISBWRE 54
#define REENTRANT_PROTO_I_iS 55
#define REENTRANT_PROTO_I_lS 56
#define REENTRANT_PROTO_I_uISBWRE 57
#define REENTRANT_PROTO_S_CBI 58
#define REENTRANT_PROTO_S_CCSBI 59
#define REENTRANT_PROTO_S_CIISBIE 60
#define REENTRANT_PROTO_S_CSBI 61
#define REENTRANT_PROTO_S_CSBIE 62
#define REENTRANT_PROTO_S_CWISBIE 63
#define REENTRANT_PROTO_S_CWISBWIE 64
#define REENTRANT_PROTO_S_ICSBI 65
#define REENTRANT_PROTO_S_ISBI 66
#define REENTRANT_PROTO_S_LISBI 67
#define REENTRANT_PROTO_S_SBI 68
#define REENTRANT_PROTO_S_SBIE 69
#define REENTRANT_PROTO_S_SBW 70
#define REENTRANT_PROTO_S_TISBI 71
#define REENTRANT_PROTO_S_TS 72
#define REENTRANT_PROTO_S_TSBI 73
#define REENTRANT_PROTO_S_TSBIE 74
#define REENTRANT_PROTO_S_TWISBIE 75
#define REENTRANT_PROTO_V_D 76
#define REENTRANT_PROTO_V_H 77
#define REENTRANT_PROTO_V_ID 78
/* Defines for indicating which special features are supported. */
/* The getgrent getgrgid getgrnam using buffer? */
#if defined(HAS_GETGRENT_R) && (GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBIR || GETGRENT_R_PROTO == REENTRANT_PROTO_S_SBW || GETGRENT_R_PROTO == REENTRANT_PROTO_S_SBI || GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBI || GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBIH)
# define GETGRENT_R_HAS_BUFFER
#else
# undef GETGRENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETGRGID_R) && (GETGRGID_R_PROTO == REENTRANT_PROTO_I_TSBWR || GETGRGID_R_PROTO == REENTRANT_PROTO_I_TSBIR || GETGRGID_R_PROTO == REENTRANT_PROTO_I_TSBI || GETGRGID_R_PROTO == REENTRANT_PROTO_S_TSBI)
# define GETGRGID_R_HAS_BUFFER
#else
# undef GETGRGID_R_HAS_BUFFER
#endif
#if defined(HAS_GETGRNAM_R) && (GETGRNAM_R_PROTO == REENTRANT_PROTO_I_CSBWR || GETGRNAM_R_PROTO == REENTRANT_PROTO_I_CSBIR || GETGRNAM_R_PROTO == REENTRANT_PROTO_S_CBI || GETGRNAM_R_PROTO == REENTRANT_PROTO_I_CSBI || GETGRNAM_R_PROTO == REENTRANT_PROTO_S_CSBI)
# define GETGRNAM_R_HAS_BUFFER
#else
# undef GETGRNAM_R_HAS_BUFFER
#endif
/* Any of the getgrent getgrgid getgrnam using buffer? */
#if (defined(GETGRENT_R_HAS_BUFFER) || defined(GETGRGID_R_HAS_BUFFER) || defined(GETGRNAM_R_HAS_BUFFER))
# define USE_GRENT_BUFFER
#else
# undef USE_GRENT_BUFFER
#endif
/* The getgrent getgrgid getgrnam using ptr? */
#if defined(HAS_GETGRENT_R) && (GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBIR)
# define GETGRENT_R_HAS_PTR
#else
# undef GETGRENT_R_HAS_PTR
#endif
#if defined(HAS_GETGRGID_R) && (GETGRGID_R_PROTO == REENTRANT_PROTO_I_TSBWR || GETGRGID_R_PROTO == REENTRANT_PROTO_I_TSBIR)
# define GETGRGID_R_HAS_PTR
#else
# undef GETGRGID_R_HAS_PTR
#endif
#if defined(HAS_GETGRNAM_R) && (GETGRNAM_R_PROTO == REENTRANT_PROTO_I_CSBWR || GETGRNAM_R_PROTO == REENTRANT_PROTO_I_CSBIR)
# define GETGRNAM_R_HAS_PTR
#else
# undef GETGRNAM_R_HAS_PTR
#endif
/* Any of the getgrent getgrgid getgrnam using ptr? */
#if (defined(GETGRENT_R_HAS_PTR) || defined(GETGRGID_R_HAS_PTR) || defined(GETGRNAM_R_HAS_PTR))
# define USE_GRENT_PTR
#else
# undef USE_GRENT_PTR
#endif
/* The getpwent getpwnam getpwuid using ptr? */
#if defined(HAS_GETPWENT_R) && (GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBIR)
# define GETPWENT_R_HAS_PTR
#else
# undef GETPWENT_R_HAS_PTR
#endif
#if defined(HAS_GETPWNAM_R) && (GETPWNAM_R_PROTO == REENTRANT_PROTO_I_CSBWR || GETPWNAM_R_PROTO == REENTRANT_PROTO_I_CSBIR)
# define GETPWNAM_R_HAS_PTR
#else
# undef GETPWNAM_R_HAS_PTR
#endif
#if defined(HAS_GETPWUID_R) && (GETPWUID_R_PROTO == REENTRANT_PROTO_I_TSBWR || GETPWUID_R_PROTO == REENTRANT_PROTO_I_TSBIR)
# define GETPWUID_R_HAS_PTR
#else
# undef GETPWUID_R_HAS_PTR
#endif
/* Any of the getpwent getpwnam getpwuid using ptr? */
#if (defined(GETPWENT_R_HAS_PTR) || defined(GETPWNAM_R_HAS_PTR) || defined(GETPWUID_R_HAS_PTR))
# define USE_PWENT_PTR
#else
# undef USE_PWENT_PTR
#endif
/* The getspent getspnam using ptr? */
#if defined(HAS_GETSPNAM_R) && (GETSPNAM_R_PROTO == REENTRANT_PROTO_I_CSBWR)
# define GETSPNAM_R_HAS_PTR
#else
# undef GETSPNAM_R_HAS_PTR
#endif
/* Any of the getspent getspnam using ptr? */
#if (defined(GETSPENT_R_HAS_PTR) || defined(GETSPNAM_R_HAS_PTR))
# define USE_SPENT_PTR
#else
# undef USE_SPENT_PTR
#endif
/* The getgrent getgrgid getgrnam setgrent endgrent using fptr? */
#if defined(HAS_GETGRENT_R) && (GETGRENT_R_PROTO == REENTRANT_PROTO_I_SBIH)
# define GETGRENT_R_HAS_FPTR
#else
# undef GETGRENT_R_HAS_FPTR
#endif
#if defined(HAS_SETGRENT_R) && (SETGRENT_R_PROTO == REENTRANT_PROTO_I_H || SETGRENT_R_PROTO == REENTRANT_PROTO_V_H)
# define SETGRENT_R_HAS_FPTR
#else
# undef SETGRENT_R_HAS_FPTR
#endif
#if defined(HAS_ENDGRENT_R) && (ENDGRENT_R_PROTO == REENTRANT_PROTO_I_H || ENDGRENT_R_PROTO == REENTRANT_PROTO_V_H)
# define ENDGRENT_R_HAS_FPTR
#else
# undef ENDGRENT_R_HAS_FPTR
#endif
/* Any of the getgrent getgrgid getgrnam setgrent endgrent using fptr? */
#if (defined(GETGRENT_R_HAS_FPTR) || defined(GETGRGID_R_HAS_FPTR) || defined(GETGRNAM_R_HAS_FPTR) || defined(SETGRENT_R_HAS_FPTR) || defined(ENDGRENT_R_HAS_FPTR))
# define USE_GRENT_FPTR
#else
# undef USE_GRENT_FPTR
#endif
/* The getpwent getpwnam getpwuid setpwent endpwent using fptr? */
#if defined(HAS_GETPWENT_R) && (GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBIH)
# define GETPWENT_R_HAS_FPTR
#else
# undef GETPWENT_R_HAS_FPTR
#endif
#if defined(HAS_SETPWENT_R) && (SETPWENT_R_PROTO == REENTRANT_PROTO_I_H || SETPWENT_R_PROTO == REENTRANT_PROTO_V_H)
# define SETPWENT_R_HAS_FPTR
#else
# undef SETPWENT_R_HAS_FPTR
#endif
#if defined(HAS_ENDPWENT_R) && (ENDPWENT_R_PROTO == REENTRANT_PROTO_I_H || ENDPWENT_R_PROTO == REENTRANT_PROTO_V_H)
# define ENDPWENT_R_HAS_FPTR
#else
# undef ENDPWENT_R_HAS_FPTR
#endif
/* Any of the getpwent getpwnam getpwuid setpwent endpwent using fptr? */
#if (defined(GETPWENT_R_HAS_FPTR) || defined(GETPWNAM_R_HAS_FPTR) || defined(GETPWUID_R_HAS_FPTR) || defined(SETPWENT_R_HAS_FPTR) || defined(ENDPWENT_R_HAS_FPTR))
# define USE_PWENT_FPTR
#else
# undef USE_PWENT_FPTR
#endif
/* The getpwent getpwgid getpwnam using buffer? */
#if defined(HAS_GETPWENT_R) && (GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBIR || GETPWENT_R_PROTO == REENTRANT_PROTO_S_SBW || GETPWENT_R_PROTO == REENTRANT_PROTO_S_SBI || GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBI || GETPWENT_R_PROTO == REENTRANT_PROTO_I_SBIH)
# define GETPWENT_R_HAS_BUFFER
#else
# undef GETPWENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETPWNAM_R) && (GETPWNAM_R_PROTO == REENTRANT_PROTO_I_CSBWR || GETPWNAM_R_PROTO == REENTRANT_PROTO_I_CSBIR || GETPWNAM_R_PROTO == REENTRANT_PROTO_S_CSBI || GETPWNAM_R_PROTO == REENTRANT_PROTO_I_CSBI)
# define GETPWNAM_R_HAS_BUFFER
#else
# undef GETPWNAM_R_HAS_BUFFER
#endif
/* Any of the getpwent getpwgid getpwnam using buffer? */
#if (defined(GETPWENT_R_HAS_BUFFER) || defined(GETPWGID_R_HAS_BUFFER) || defined(GETPWNAM_R_HAS_BUFFER))
# define USE_PWENT_BUFFER
#else
# undef USE_PWENT_BUFFER
#endif
/* The gethostent gethostbyaddr gethostbyname using ptr? */
#if defined(HAS_GETHOSTENT_R) && (GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBWRE)
# define GETHOSTENT_R_HAS_PTR
#else
# undef GETHOSTENT_R_HAS_PTR
#endif
#if defined(HAS_GETHOSTBYADDR_R) && (GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_CWISBWRE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_TsISBWRE)
# define GETHOSTBYADDR_R_HAS_PTR
#else
# undef GETHOSTBYADDR_R_HAS_PTR
#endif
#if defined(HAS_GETHOSTBYNAME_R) && (GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE)
# define GETHOSTBYNAME_R_HAS_PTR
#else
# undef GETHOSTBYNAME_R_HAS_PTR
#endif
/* Any of the gethostent gethostbyaddr gethostbyname using ptr? */
#if (defined(GETHOSTENT_R_HAS_PTR) || defined(GETHOSTBYADDR_R_HAS_PTR) || defined(GETHOSTBYNAME_R_HAS_PTR))
# define USE_HOSTENT_PTR
#else
# undef USE_HOSTENT_PTR
#endif
/* The getnetent getnetbyaddr getnetbyname using ptr? */
#if defined(HAS_GETNETENT_R) && (GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBWRE)
# define GETNETENT_R_HAS_PTR
#else
# undef GETNETENT_R_HAS_PTR
#endif
#if defined(HAS_GETNETBYADDR_R) && (GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_UISBWRE || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_uISBWRE)
# define GETNETBYADDR_R_HAS_PTR
#else
# undef GETNETBYADDR_R_HAS_PTR
#endif
#if defined(HAS_GETNETBYNAME_R) && (GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE)
# define GETNETBYNAME_R_HAS_PTR
#else
# undef GETNETBYNAME_R_HAS_PTR
#endif
/* Any of the getnetent getnetbyaddr getnetbyname using ptr? */
#if (defined(GETNETENT_R_HAS_PTR) || defined(GETNETBYADDR_R_HAS_PTR) || defined(GETNETBYNAME_R_HAS_PTR))
# define USE_NETENT_PTR
#else
# undef USE_NETENT_PTR
#endif
/* The getprotoent getprotobyname getprotobynumber using ptr? */
#if defined(HAS_GETPROTOENT_R) && (GETPROTOENT_R_PROTO == REENTRANT_PROTO_I_SBWR)
# define GETPROTOENT_R_HAS_PTR
#else
# undef GETPROTOENT_R_HAS_PTR
#endif
#if defined(HAS_GETPROTOBYNAME_R) && (GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWR)
# define GETPROTOBYNAME_R_HAS_PTR
#else
# undef GETPROTOBYNAME_R_HAS_PTR
#endif
#if defined(HAS_GETPROTOBYNUMBER_R) && (GETPROTOBYNUMBER_R_PROTO == REENTRANT_PROTO_I_ISBWR)
# define GETPROTOBYNUMBER_R_HAS_PTR
#else
# undef GETPROTOBYNUMBER_R_HAS_PTR
#endif
/* Any of the getprotoent getprotobyname getprotobynumber using ptr? */
#if (defined(GETPROTOENT_R_HAS_PTR) || defined(GETPROTOBYNAME_R_HAS_PTR) || defined(GETPROTOBYNUMBER_R_HAS_PTR))
# define USE_PROTOENT_PTR
#else
# undef USE_PROTOENT_PTR
#endif
/* The getservent getservbyname getservbyport using ptr? */
#if defined(HAS_GETSERVENT_R) && (GETSERVENT_R_PROTO == REENTRANT_PROTO_I_SBWR)
# define GETSERVENT_R_HAS_PTR
#else
# undef GETSERVENT_R_HAS_PTR
#endif
#if defined(HAS_GETSERVBYNAME_R) && (GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSBWR)
# define GETSERVBYNAME_R_HAS_PTR
#else
# undef GETSERVBYNAME_R_HAS_PTR
#endif
#if defined(HAS_GETSERVBYPORT_R) && (GETSERVBYPORT_R_PROTO == REENTRANT_PROTO_I_ICSBWR)
# define GETSERVBYPORT_R_HAS_PTR
#else
# undef GETSERVBYPORT_R_HAS_PTR
#endif
/* Any of the getservent getservbyname getservbyport using ptr? */
#if (defined(GETSERVENT_R_HAS_PTR) || defined(GETSERVBYNAME_R_HAS_PTR) || defined(GETSERVBYPORT_R_HAS_PTR))
# define USE_SERVENT_PTR
#else
# undef USE_SERVENT_PTR
#endif
/* The gethostent gethostbyaddr gethostbyname using buffer? */
#if defined(HAS_GETHOSTENT_R) && (GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBWRE || GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBIE || GETHOSTENT_R_PROTO == REENTRANT_PROTO_S_SBIE || GETHOSTENT_R_PROTO == REENTRANT_PROTO_S_SBI || GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBI)
# define GETHOSTENT_R_HAS_BUFFER
#else
# undef GETHOSTENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETHOSTBYADDR_R) && (GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_CWISBWRE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CWISBWIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CWISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_TWISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CIISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CSBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_TSBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_TsISBWRE)
# define GETHOSTBYADDR_R_HAS_BUFFER
#else
# undef GETHOSTBYADDR_R_HAS_BUFFER
#endif
#if defined(HAS_GETHOSTBYNAME_R) && (GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE || GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_S_CSBIE)
# define GETHOSTBYNAME_R_HAS_BUFFER
#else
# undef GETHOSTBYNAME_R_HAS_BUFFER
#endif
/* Any of the gethostent gethostbyaddr gethostbyname using buffer? */
#if (defined(GETHOSTENT_R_HAS_BUFFER) || defined(GETHOSTBYADDR_R_HAS_BUFFER) || defined(GETHOSTBYNAME_R_HAS_BUFFER))
# define USE_HOSTENT_BUFFER
#else
# undef USE_HOSTENT_BUFFER
#endif
/* The getnetent getnetbyaddr getnetbyname using buffer? */
#if defined(HAS_GETNETENT_R) && (GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBWRE || GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBIE || GETNETENT_R_PROTO == REENTRANT_PROTO_S_SBIE || GETNETENT_R_PROTO == REENTRANT_PROTO_S_SBI || GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBI)
# define GETNETENT_R_HAS_BUFFER
#else
# undef GETNETENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETNETBYADDR_R) && (GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_UISBWRE || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_LISBI || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_S_TISBI || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_S_LISBI || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_uISBWRE)
# define GETNETBYADDR_R_HAS_BUFFER
#else
# undef GETNETBYADDR_R_HAS_BUFFER
#endif
#if defined(HAS_GETNETBYNAME_R) && (GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE || GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBI || GETNETBYNAME_R_PROTO == REENTRANT_PROTO_S_CSBI)
# define GETNETBYNAME_R_HAS_BUFFER
#else
# undef GETNETBYNAME_R_HAS_BUFFER
#endif
/* Any of the getnetent getnetbyaddr getnetbyname using buffer? */
#if (defined(GETNETENT_R_HAS_BUFFER) || defined(GETNETBYADDR_R_HAS_BUFFER) || defined(GETNETBYNAME_R_HAS_BUFFER))
# define USE_NETENT_BUFFER
#else
# undef USE_NETENT_BUFFER
#endif
/* The getprotoent getprotobyname getprotobynumber using buffer? */
#if defined(HAS_GETPROTOENT_R) && (GETPROTOENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETPROTOENT_R_PROTO == REENTRANT_PROTO_I_SBI || GETPROTOENT_R_PROTO == REENTRANT_PROTO_S_SBI)
# define GETPROTOENT_R_HAS_BUFFER
#else
# undef GETPROTOENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETPROTOBYNAME_R) && (GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWR || GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_S_CSBI)
# define GETPROTOBYNAME_R_HAS_BUFFER
#else
# undef GETPROTOBYNAME_R_HAS_BUFFER
#endif
#if defined(HAS_GETPROTOBYNUMBER_R) && (GETPROTOBYNUMBER_R_PROTO == REENTRANT_PROTO_I_ISBWR || GETPROTOBYNUMBER_R_PROTO == REENTRANT_PROTO_S_ISBI)
# define GETPROTOBYNUMBER_R_HAS_BUFFER
#else
# undef GETPROTOBYNUMBER_R_HAS_BUFFER
#endif
/* Any of the getprotoent getprotobyname getprotobynumber using buffer? */
#if (defined(GETPROTOENT_R_HAS_BUFFER) || defined(GETPROTOBYNAME_R_HAS_BUFFER) || defined(GETPROTOBYNUMBER_R_HAS_BUFFER))
# define USE_PROTOENT_BUFFER
#else
# undef USE_PROTOENT_BUFFER
#endif
/* The getservent getservbyname getservbyport using buffer? */
#if defined(HAS_GETSERVENT_R) && (GETSERVENT_R_PROTO == REENTRANT_PROTO_I_SBWR || GETSERVENT_R_PROTO == REENTRANT_PROTO_I_SBI || GETSERVENT_R_PROTO == REENTRANT_PROTO_S_SBI)
# define GETSERVENT_R_HAS_BUFFER
#else
# undef GETSERVENT_R_HAS_BUFFER
#endif
#if defined(HAS_GETSERVBYNAME_R) && (GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSBWR || GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_S_CCSBI)
# define GETSERVBYNAME_R_HAS_BUFFER
#else
# undef GETSERVBYNAME_R_HAS_BUFFER
#endif
#if defined(HAS_GETSERVBYPORT_R) && (GETSERVBYPORT_R_PROTO == REENTRANT_PROTO_I_ICSBWR || GETSERVBYPORT_R_PROTO == REENTRANT_PROTO_S_ICSBI)
# define GETSERVBYPORT_R_HAS_BUFFER
#else
# undef GETSERVBYPORT_R_HAS_BUFFER
#endif
/* Any of the getservent getservbyname getservbyport using buffer? */
#if (defined(GETSERVENT_R_HAS_BUFFER) || defined(GETSERVBYNAME_R_HAS_BUFFER) || defined(GETSERVBYPORT_R_HAS_BUFFER))
# define USE_SERVENT_BUFFER
#else
# undef USE_SERVENT_BUFFER
#endif
/* The gethostent gethostbyaddr gethostbyname using errno? */
#if defined(HAS_GETHOSTENT_R) && (GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBWRE || GETHOSTENT_R_PROTO == REENTRANT_PROTO_I_SBIE || GETHOSTENT_R_PROTO == REENTRANT_PROTO_S_SBIE)
# define GETHOSTENT_R_HAS_ERRNO
#else
# undef GETHOSTENT_R_HAS_ERRNO
#endif
#if defined(HAS_GETHOSTBYADDR_R) && (GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_CWISBWRE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CWISBWIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CWISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_TWISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CIISBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_CSBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_S_TSBIE || GETHOSTBYADDR_R_PROTO == REENTRANT_PROTO_I_TsISBWRE)
# define GETHOSTBYADDR_R_HAS_ERRNO
#else
# undef GETHOSTBYADDR_R_HAS_ERRNO
#endif
#if defined(HAS_GETHOSTBYNAME_R) && (GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE || GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_S_CSBIE)
# define GETHOSTBYNAME_R_HAS_ERRNO
#else
# undef GETHOSTBYNAME_R_HAS_ERRNO
#endif
/* Any of the gethostent gethostbyaddr gethostbyname using errno? */
#if (defined(GETHOSTENT_R_HAS_ERRNO) || defined(GETHOSTBYADDR_R_HAS_ERRNO) || defined(GETHOSTBYNAME_R_HAS_ERRNO))
# define USE_HOSTENT_ERRNO
#else
# undef USE_HOSTENT_ERRNO
#endif
/* The getnetent getnetbyaddr getnetbyname using errno? */
#if defined(HAS_GETNETENT_R) && (GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBWRE || GETNETENT_R_PROTO == REENTRANT_PROTO_I_SBIE || GETNETENT_R_PROTO == REENTRANT_PROTO_S_SBIE)
# define GETNETENT_R_HAS_ERRNO
#else
# undef GETNETENT_R_HAS_ERRNO
#endif
#if defined(HAS_GETNETBYADDR_R) && (GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_UISBWRE || GETNETBYADDR_R_PROTO == REENTRANT_PROTO_I_uISBWRE)
# define GETNETBYADDR_R_HAS_ERRNO
#else
# undef GETNETBYADDR_R_HAS_ERRNO
#endif
#if defined(HAS_GETNETBYNAME_R) && (GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSBWRE)
# define GETNETBYNAME_R_HAS_ERRNO
#else
# undef GETNETBYNAME_R_HAS_ERRNO
#endif
/* Any of the getnetent getnetbyaddr getnetbyname using errno? */
#if (defined(GETNETENT_R_HAS_ERRNO) || defined(GETNETBYADDR_R_HAS_ERRNO) || defined(GETNETBYNAME_R_HAS_ERRNO))
# define USE_NETENT_ERRNO
#else
# undef USE_NETENT_ERRNO
#endif
typedef struct {
#ifdef HAS_ASCTIME_R
char* _asctime_buffer;
size_t _asctime_size;
#endif /* HAS_ASCTIME_R */
#ifdef HAS_CRYPT_R
#if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
CRYPTD* _crypt_data;
#else
struct crypt_data _crypt_struct;
#endif
#endif /* HAS_CRYPT_R */
#ifdef HAS_CTIME_R
char* _ctime_buffer;
size_t _ctime_size;
#endif /* HAS_CTIME_R */
#ifdef HAS_DRAND48_R
struct drand48_data _drand48_struct;
double _drand48_double;
#endif /* HAS_DRAND48_R */
#ifdef HAS_GETGRNAM_R
struct group _grent_struct;
char* _grent_buffer;
size_t _grent_size;
# ifdef USE_GRENT_PTR
struct group* _grent_ptr;
# endif
# ifdef USE_GRENT_FPTR
FILE* _grent_fptr;
# endif
#endif /* HAS_GETGRNAM_R */
#ifdef HAS_GETHOSTBYNAME_R
struct hostent _hostent_struct;
# if GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD
struct hostent_data _hostent_data;
# else
char* _hostent_buffer;
size_t _hostent_size;
# endif
# ifdef USE_HOSTENT_PTR
struct hostent* _hostent_ptr;
# endif
# ifdef USE_HOSTENT_ERRNO
int _hostent_errno;
# endif
#endif /* HAS_GETHOSTBYNAME_R */
#ifdef HAS_GETLOGIN_R
char* _getlogin_buffer;
size_t _getlogin_size;
#endif /* HAS_GETLOGIN_R */
#ifdef HAS_GETNETBYNAME_R
struct netent _netent_struct;
# if GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD
struct netent_data _netent_data;
# else
char* _netent_buffer;
size_t _netent_size;
# endif
# ifdef USE_NETENT_PTR
struct netent* _netent_ptr;
# endif
# ifdef USE_NETENT_ERRNO
int _netent_errno;
# endif
#endif /* HAS_GETNETBYNAME_R */
#ifdef HAS_GETPROTOBYNAME_R
struct protoent _protoent_struct;
# if GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD
struct protoent_data _protoent_data;
# else
char* _protoent_buffer;
size_t _protoent_size;
# endif
# ifdef USE_PROTOENT_PTR
struct protoent* _protoent_ptr;
# endif
# ifdef USE_PROTOENT_ERRNO
int _protoent_errno;
# endif
#endif /* HAS_GETPROTOBYNAME_R */
#ifdef HAS_GETPWNAM_R
struct passwd _pwent_struct;
char* _pwent_buffer;
size_t _pwent_size;
# ifdef USE_PWENT_PTR
struct passwd* _pwent_ptr;
# endif
# ifdef USE_PWENT_FPTR
FILE* _pwent_fptr;
# endif
#endif /* HAS_GETPWNAM_R */
#ifdef HAS_GETSERVBYNAME_R
struct servent _servent_struct;
# if GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD
struct servent_data _servent_data;
# else
char* _servent_buffer;
size_t _servent_size;
# endif
# ifdef USE_SERVENT_PTR
struct servent* _servent_ptr;
# endif
# ifdef USE_SERVENT_ERRNO
int _servent_errno;
# endif
#endif /* HAS_GETSERVBYNAME_R */
#ifdef HAS_GETSPNAM_R
struct spwd _spent_struct;
char* _spent_buffer;
size_t _spent_size;
# ifdef USE_SPENT_PTR
struct spwd* _spent_ptr;
# endif
# ifdef USE_SPENT_FPTR
FILE* _spent_fptr;
# endif
#endif /* HAS_GETSPNAM_R */
#ifdef HAS_GMTIME_R
struct tm _gmtime_struct;
#endif /* HAS_GMTIME_R */
#ifdef HAS_LOCALTIME_R
struct tm _localtime_struct;
#endif /* HAS_LOCALTIME_R */
#ifdef HAS_RANDOM_R
# if RANDOM_R_PROTO != REENTRANT_PROTO_I_St
struct random_data _random_struct;
# endif
#endif /* HAS_RANDOM_R */
#ifdef HAS_READDIR_R
struct dirent* _readdir_struct;
size_t _readdir_size;
# if READDIR_R_PROTO == REENTRANT_PROTO_I_TSR
struct dirent* _readdir_ptr;
# endif
#endif /* HAS_READDIR_R */
#ifdef HAS_READDIR64_R
struct dirent64* _readdir64_struct;
size_t _readdir64_size;
# if READDIR64_R_PROTO == REENTRANT_PROTO_I_TSR
struct dirent64* _readdir64_ptr;
# endif
#endif /* HAS_READDIR64_R */
#ifdef HAS_SETLOCALE_R
char* _setlocale_buffer;
size_t _setlocale_size;
#endif /* HAS_SETLOCALE_R */
#ifdef HAS_STRERROR_R
char* _strerror_buffer;
size_t _strerror_size;
#endif /* HAS_STRERROR_R */
#ifdef HAS_TTYNAME_R
char* _ttyname_buffer;
size_t _ttyname_size;
#endif /* HAS_TTYNAME_R */
#ifdef HAS_CRYPT_R
#if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
#else
struct crypt_data *_crypt_struct_buffer;
#endif
#endif /* HAS_CRYPT_R */
#ifdef HAS_RANDOM_R
# if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
int _random_retval;
# endif
# if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
long _random_retval;
# endif
# if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
struct random_data _random_struct;
int32_t _random_retval;
# endif
#endif /* HAS_RANDOM_R */
#ifdef HAS_SRANDOM_R
struct random_data _srandom_struct;
#endif /* HAS_SRANDOM_R */
int dummy; /* cannot have empty structs */
} REENTR;
#endif /* USE_REENTRANT_API */
#endif
--- NEW FILE: util.c ---
/* util.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "Very useful, no doubt, that was to Saruman; yet it seems that he was
* not content." --Gandalf
*/
/* This file contains assorted utility routines.
* Which is a polite way of saying any stuff that people couldn't think of
* a better place for. Amongst other things, it includes the warning and
* dieing stuff, plus wrappers for malloc code.
[...4689 lines suppressed...]
# else /* ! HAS_CLEARENV && ! HAS_UNSETENV */
/* Just null environ and accept the leakage. */
*environ = NULL;
# endif /* HAS_CLEARENV || HAS_UNSETENV */
# endif /* ! PERL_USE_SAFE_PUTENV */
}
# endif /* USE_ENVIRON_ARRAY */
# endif /* PERL_IMPLICIT_SYS || WIN32 */
#endif /* PERL_MICRO */
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README ---
Perl Kit, Version 5
Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of either:
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License" which comes with this Kit.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
the GNU General Public License or the Artistic License for more details.
You should have received a copy of the Artistic License with this
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
You should also have received a copy of the GNU General Public License
along with this program in the file named "Copying". If not, write to the
Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307, USA or visit their web page on the internet at
http://www.gnu.org/copyleft/gpl.html.
For those of you that choose to use the GNU General Public License,
my interpretation of the GNU General Public License is that no Perl
script falls under the terms of the GPL unless you explicitly put
said script under the terms of the GPL yourself. Furthermore, any
object code linked with perl does not automatically fall under the
terms of the GPL, provided such object code only adds definitions
of subroutines and variables, and does not otherwise impair the
resulting interpreter from executing any standard Perl script. I
consider linking in C subroutines in this manner to be the moral
equivalent of defining subroutines in the Perl language itself. You
may sell such an object file as proprietary provided that you provide
or offer to provide the Perl source, as specified by the GNU General
Public License. (This is merely an alternate way of specifying input
to the program.) You may also sell a binary produced by the dumping of
a running Perl script that belongs to you, provided that you provide or
offer to provide the Perl source as specified by the GPL. (The
fact that a Perl interpreter and your code are in the same binary file
is, in this case, a form of mere aggregation.) This is my interpretation
of the GPL. If you still have concerns or difficulties understanding
my intent, feel free to contact me. Of course, the Artistic License
spells all this out for your protection, so you may prefer to use that.
--------------------------------------------------------------------------
Perl is a language that combines some of the features of C, sed, awk
and shell. See the manual page for more hype. There are also many Perl
books available, covering a wide variety of topics, from various publishers.
See pod/perlbook.pod for more information.
Please read all the directions below before you proceed any further, and
then follow them carefully.
Installation
1) Detailed instructions are in the file "INSTALL", which you should
read if you are either installing on a system resembling Unix
or porting perl to another platform. For non-Unix platforms, see the
corresponding README.
2) Read the manual entries before running perl.
3) IMPORTANT! Help save the world! Communicate any problems and suggested
patches to perlbug at perl.org so we can keep the world in sync.
If you have a problem, there's someone else out there who either has had
or will have the same problem. See the section on "Reporting Problems"
in the INSTALL file.
The latest versions of perl are always available on the various CPAN
(Comprehensive Perl Archive Network) sites around the world.
See http://www.cpan.org/src/ .
Just a personal note: I want you to know that I create nice things like this
because it pleases the Author of my story. If this bothers you, then your
notion of Authorship needs some revision. But you can use perl anyway. :-)
The author.
--- NEW FILE: README.os400 ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.os400 - Perl version 5 on OS/400
=head1 DESCRIPTION
This document describes various features of IBM's OS/400 operating
system that will affect how Perl version 5 (hereafter just Perl) is
compiled and/or runs.
By far the easiest way to build Perl for OS/400 is to use the PASE
(Portable Application Solutions Environment), for more information see
http://www.iseries.ibm.com/developer/factory/pase/index.html
This environment allows one to use AIX APIs while programming, and it
provides a runtime that allows AIX binaries to execute directly on the
PowerPC iSeries.
=head2 Compiling Perl for OS/400 PASE
The recommended way to build Perl for the OS/400 PASE is to build the
Perl 5 source code (release 5.8.1 or later) under AIX.
The trick is to give a special parameter to the Configure shell script
when running it on AIX:
sh Configure -DPASE ...
The default installation directory of Perl under PASE is /QOpenSys/perl.
This can be modified if needed with Configure parameter -Dprefix=/some/dir.
Starting from OS/400 V5R2 the IBM Visual Age compiler is supported
on OS/400 PASE, so it is possible to build Perl natively on OS/400.
The easier way, however, is to compile in AIX, as just described.
If you don't want to install the compiled Perl in AIX into /QOpenSys
(for packaging it before copying it to PASE), you can use a Configure
parameter: -Dinstallprefix=/tmp/QOpenSys/perl. This will cause the
"make install" to install everything into that directory, while the
installed files still think they are (will be) in /QOpenSys/perl.
If building natively on PASE, please do the build under the /QOpenSys
directory, since Perl is happier when built on a case sensitive filesystem.
=head2 Installing Perl in OS/400 PASE
If you are compiling on AIX, simply do a "make install" on the AIX box.
Once the install finishes, tar up the /QOpenSys/perl directory. Transfer
the tarball to the OS/400 using FTP with the following commands:
> binary
> site namefmt 1
> put perl.tar /QOpenSys
Once you have it on, simply bring up a PASE shell and extract the tarball.
If you are compiling in PASE, then "make install" is the only thing you
will need to do.
The default path for perl binary is /QOpenSys/perl/bin/perl. You'll
want to symlink /QOpenSys/usr/bin/perl to this file so you don't have
to modify your path.
=head2 Using Perl in OS/400 PASE
Perl in PASE may be used in the same manner as you would use Perl on AIX.
Scripts starting with #!/usr/bin/perl should work if you have
/QOpenSys/usr/bin/perl symlinked to your perl binary. This will not
work if you've done a setuid/setgid or have environment variable
PASE_EXEC_QOPENSYS="N". If you have V5R1, you'll need to get the
latest PTFs to have this feature. Scripts starting with
#!/QOpenSys/perl/bin/perl should always work.
=head2 Known Problems
When compiling in PASE, there is no "oslevel" command. Therefore,
you may want to create a script called "oslevel" that echoes the
level of AIX that your version of PASE runtime supports. If you're
unsure, consult your documentation or use "4.3.3.0".
If you have test cases that fail, check for the existence of spool files.
The test case may be trying to use a syscall that is not implemented
in PASE. To avoid the SIGILL, try setting the PASE_SYSCALL_NOSIGILL
environment variable or have a handler for the SIGILL. If you can
compile programs for PASE, run the config script and edit config.sh
when it gives you the option. If you want to remove fchdir(), which
isn't implement in V5R1, simply change the line that says:
d_fchdir='define'
to
d_fchdir='undef'
and then compile Perl. The places where fchdir() is used have
alternatives for systems that do not have fchdir() available.
=head2 Perl on ILE
There exists a port of Perl to the ILE environment. This port, however,
is based quite an old release of Perl, Perl 5.00502 (August 1998).
(As of July 2002 the latest release of Perl is 5.8.0, and even 5.6.1
has been out since April 2001.) If you need to run Perl on ILE, though,
you may need this older port: http://www.cpan.org/ports/#os400
Note that any Perl release later than 5.00502 has not been ported to ILE.
If you need to use Perl in the ILE environment, you may want to consider
using Qp2RunPase() to call the PASE version of Perl.
=head1 AUTHORS
Jarkko Hietaniemi <jhi at iki.fi>
Bryan Logan <bryanlog at us.ibm.com>
David Larson <larson1 at us.ibm.com>
=cut
--- NEW FILE: util.h ---
/* util.h
*
* Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef VMS
# define PERL_FILE_IS_ABSOLUTE(f) \
(*(f) == '/' \
|| (strchr(f,':') \
|| ((*(f) == '[' || *(f) == '<') \
&& (isALNUM((f)[1]) || strchr("$-_]>",(f)[1])))))
#else /* !VMS */
# if defined(WIN32) || defined(__CYGWIN__)
# define PERL_FILE_IS_ABSOLUTE(f) \
(*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \
|| ((f)[0] && (f)[1] == ':')) /* drive name */
# else /* !WIN32 */
# ifdef NETWARE
# define PERL_FILE_IS_ABSOLUTE(f) \
(((f)[0] && (f)[1] == ':') /* drive name */ \
|| ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \
|| ((f)[3] == ':')) /* volume name, currently only sys */
# else /* !NETWARE */
# if defined( DOSISH) || defined(EPOC)
# define PERL_FILE_IS_ABSOLUTE(f) \
(*(f) == '/' \
|| ((f)[0] && (f)[1] == ':')) /* drive name */
# else /* NEITHER DOSISH NOR EPOCISH */
# ifdef MACOS_TRADITIONAL
# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':') && *(f) != ':')
# else /* !MACOS_TRADITIONAL */
# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/')
# endif /* MACOS_TRADITIONAL */
# endif /* DOSISH */
# endif /* NETWARE */
# endif /* WIN32 */
#endif /* VMS */
--- NEW FILE: malloc_ctl.h ---
#ifndef MALLOC_CTL_H
# define MALLOC_CTL_H
struct perl_mstats {
UV *nfree;
UV *ntotal;
IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
IV minbucket;
/* Level 1 info */
UV *bucket_mem_size;
UV *bucket_available_size;
UV nbuckets;
};
typedef struct perl_mstats perl_mstats_t;
START_EXTERN_C
Malloc_t Perl_malloc (MEM_SIZE nbytes);
Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
/* 'mfree' rather than 'free', since there is already a 'perl_free'
* that causes clashes with case-insensitive linkers */
Free_t Perl_mfree (Malloc_t where);
END_EXTERN_C
#ifndef NO_MALLOC_DYNAMIC_CFG
/* IV configuration data */
enum {
MallocCfg_FIRST_SBRK,
MallocCfg_MIN_SBRK,
MallocCfg_MIN_SBRK_FRAC1000,
MallocCfg_SBRK_ALLOW_FAILURES,
MallocCfg_SBRK_FAILURE_PRICE,
MallocCfg_sbrk_goodness,
MallocCfg_filldead,
MallocCfg_fillalive,
MallocCfg_fillcheck,
MallocCfg_skip_cfg_env,
MallocCfg_cfg_env_read,
MallocCfg_emergency_buffer_size,
MallocCfg_emergency_buffer_last_req,
MallocCfg_emergency_buffer_prepared_size,
MallocCfg_last
};
/* char* configuration data */
enum {
MallocCfgP_emergency_buffer,
MallocCfgP_emergency_buffer_prepared,
MallocCfgP_last
};
START_EXTERN_C
extern IV *MallocCfg_ptr;
extern char **MallocCfgP_ptr;
END_EXTERN_C
#endif
#endif
--- NEW FILE: universal.c ---
/* universal.c
*
* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
* 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "The roots of those mountains must be roots indeed; there must be
* great secrets buried there which have not been discovered since the
* beginning." --Gandalf, relating Gollum's story
*/
/* This file contains the code that implements the functions in Perl's
* UNIVERSAL package, such as UNIVERSAL->can().
*/
#include "EXTERN.h"
#define PERL_IN_UNIVERSAL_C
#include "perl.h"
#ifdef USE_PERLIO
#include "perliol.h" /* For the PERLIO_F_XXX */
#endif
/*
* Contributed by Graham Barr <Graham.Barr at tiuk.ti.com>
* The main guts of traverse_isa was actually copied from gv_fetchmeth
*/
STATIC SV *
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
int len, int level)
{
AV* av;
GV* gv;
GV** gvp;
HV* hv = Nullhv;
SV* subgen = Nullsv;
const char *hvname;
/* A stash/class can go by many names (ie. User == main::User), so
we compare the stash itself just in case */
if (name_stash && (stash == name_stash))
return &PL_sv_yes;
hvname = HvNAME_get(stash);
if (strEQ(hvname, name))
return &PL_sv_yes;
if (strEQ(name, "UNIVERSAL"))
return &PL_sv_yes;
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
hvname);
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
{
if (SvIV(subgen) == (IV)PL_sub_generation) {
SV* sv;
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
name, hvname) );
return sv;
}
}
else {
DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
hvname) );
hv_clear(hv);
sv_setiv(subgen, PL_sub_generation);
}
}
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if (!hv || !subgen) {
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
gv = *gvp;
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
if (!hv)
hv = GvHVn(gv);
if (!subgen) {
subgen = newSViv(PL_sub_generation);
GvSV(gv) = subgen;
}
}
if (hv) {
SV** svp = AvARRAY(av);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Can't locate package %"SVf" for @%s::ISA",
sv, hvname);
continue;
}
if (&PL_sv_yes == isa_lookup(basestash, name, name_stash,
len, level + 1)) {
(void)hv_store(hv,name,len,&PL_sv_yes,0);
return &PL_sv_yes;
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
return &PL_sv_no;
}
/*
=head1 SV Manipulation Functions
=for apidoc sv_derived_from
Returns a boolean indicating whether the SV is derived from the specified
class. This is the function that implements C<UNIVERSAL::isa>. It works
for class names as well as for objects.
=cut
*/
bool
Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
{
const char *type = Nullch;
HV *stash = Nullhv;
HV *name_stash;
if (SvGMAGICAL(sv))
mg_get(sv) ;
if (SvROK(sv)) {
sv = SvRV(sv);
type = sv_reftype(sv,0);
if (SvOBJECT(sv))
stash = SvSTASH(sv);
}
else {
stash = gv_stashsv(sv, FALSE);
}
name_stash = gv_stashpv(name, FALSE);
return (type && strEQ(type,name)) ||
(stash && isa_lookup(stash, name, name_stash, strlen(name), 0)
== &PL_sv_yes)
? TRUE
: FALSE ;
}
#include "XSUB.h"
PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
XS(XS_utf8_is_utf8);
XS(XS_utf8_valid);
XS(XS_utf8_encode);
XS(XS_utf8_decode);
XS(XS_utf8_upgrade);
XS(XS_utf8_downgrade);
XS(XS_utf8_unicode_to_native);
XS(XS_utf8_native_to_unicode);
XS(XS_Internals_SvREADONLY);
XS(XS_Internals_SvREFCNT);
XS(XS_Internals_hv_clear_placehold);
XS(XS_PerlIO_get_layers);
XS(XS_Regexp_DESTROY);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
void
Perl_boot_core_UNIVERSAL(pTHX)
{
const char file[] = __FILE__;
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, (char *)file);
newXS("UNIVERSAL::can", XS_UNIVERSAL_can, (char *)file);
newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, (char *)file);
newXS("utf8::is_utf8", XS_utf8_is_utf8, (char *)file);
newXS("utf8::valid", XS_utf8_valid, (char *)file);
newXS("utf8::encode", XS_utf8_encode, (char *)file);
newXS("utf8::decode", XS_utf8_decode, (char *)file);
newXS("utf8::upgrade", XS_utf8_upgrade, (char *)file);
newXS("utf8::downgrade", XS_utf8_downgrade, (char *)file);
newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, (char *)file);
newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, (char *)file);
newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, (char *)file, "\\[$%@];$");
newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, (char *)file, "\\[$%@];$");
newXSproto("Internals::hv_clear_placeholders",
XS_Internals_hv_clear_placehold, (char *)file, "\\%");
newXSproto("PerlIO::get_layers",
XS_PerlIO_get_layers, (char *)file, "*;@");
newXS("Regexp::DESTROY", XS_Regexp_DESTROY, (char *)file);
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, (char *)file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, (char *)file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, (char *)file, "\\%");
}
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
SV *sv;
const char *name;
if (items != 2)
Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
sv = ST(0);
if (SvGMAGICAL(sv))
mg_get(sv);
if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
XSRETURN_UNDEF;
name = SvPV_nolen_const(ST(1));
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
}
XS(XS_UNIVERSAL_can)
{
dXSARGS;
SV *sv;
const char *name;
SV *rv;
HV *pkg = NULL;
if (items != 2)
Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
sv = ST(0);
if (SvGMAGICAL(sv))
mg_get(sv);
if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
XSRETURN_UNDEF;
name = SvPV_nolen_const(ST(1));
rv = &PL_sv_undef;
if (SvROK(sv)) {
sv = (SV*)SvRV(sv);
if (SvOBJECT(sv))
pkg = SvSTASH(sv);
}
else {
pkg = gv_stashsv(sv, FALSE);
}
if (pkg) {
GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE);
if (gv && isGV(gv))
rv = sv_2mortal(newRV((SV*)GvCV(gv)));
}
ST(0) = rv;
XSRETURN(1);
}
XS(XS_UNIVERSAL_VERSION)
{
dXSARGS;
HV *pkg;
GV **gvp;
GV *gv;
SV *sv;
const char *undef;
if (SvROK(ST(0))) {
sv = (SV*)SvRV(ST(0));
if (!SvOBJECT(sv))
Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
pkg = SvSTASH(sv);
}
else {
pkg = gv_stashsv(ST(0), FALSE);
}
gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**);
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
SV *nsv = sv_newmortal();
sv_setsv(nsv, sv);
sv = nsv;
undef = Nullch;
}
else {
sv = (SV*)&PL_sv_undef;
undef = "(undef)";
}
if (items > 1) {
SV *req = ST(1);
if (undef) {
if (pkg) {
const char *name = HvNAME_get(pkg);
Perl_croak(aTHX_
"%s does not define $%s::VERSION--version check failed",
name, name);
} else {
Perl_croak(aTHX_
"%s defines neither package nor VERSION--version check failed",
SvPVx_nolen_const(ST(0)) );
}
}
if (!SvNIOK(sv) && SvPOK(sv)) {
STRLEN len;
char *str = SvPVx(sv,len);
while (len) {
--len;
/* XXX could DWIM "1.2.3" here */
if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_')
break;
}
if (len) {
if (SvNOK(req) && SvPOK(req)) {
/* they said C<use Foo v1.2.3> and $Foo::VERSION
* doesn't look like a float: do string compare */
if (sv_cmp(req,sv) == 1) {
Perl_croak(aTHX_ "%s v%"VDf" required--"
"this is only v%"VDf,
HvNAME(pkg), req, sv);
}
goto finish;
}
/* they said C<use Foo 1.002_003> and $Foo::VERSION
* doesn't look like a float: force numeric compare */
(void)SvUPGRADE(sv, SVt_PVNV);
SvNVX(sv) = str_to_version(sv);
SvPOK_off(sv);
SvNOK_on(sv);
}
}
/* if we get here, we're looking for a numeric comparison,
* so force the required version into a float, even if they
* said C<use Foo v1.2.3> */
if (SvNOK(req) && SvPOK(req)) {
NV n = SvNV(req);
req = sv_newmortal();
sv_setnv(req, n);
}
if (SvNV(req) > SvNV(sv))
Perl_croak(aTHX_ "%s version %s required--this is only version %s",
HvNAME_get(pkg), SvPV_nolen(req), SvPV_nolen(sv));
}
finish:
ST(0) = sv;
XSRETURN(1);
}
XS(XS_utf8_is_utf8)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
{
const SV *sv = ST(0);
{
if (SvUTF8(sv))
XSRETURN_YES;
else
XSRETURN_NO;
}
}
XSRETURN_EMPTY;
}
XS(XS_utf8_valid)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
{
SV * sv = ST(0);
{
STRLEN len;
const char *s = SvPV_const(sv,len);
if (!SvUTF8(sv) || is_utf8_string((U8*)s,len))
XSRETURN_YES;
else
XSRETURN_NO;
}
}
XSRETURN_EMPTY;
}
XS(XS_utf8_encode)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
{
SV * sv = ST(0);
sv_utf8_encode(sv);
}
XSRETURN_EMPTY;
}
XS(XS_utf8_decode)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
{
SV * sv = ST(0);
const bool RETVAL = sv_utf8_decode(sv);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_utf8_upgrade)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
{
SV * sv = ST(0);
STRLEN RETVAL;
dXSTARG;
RETVAL = sv_utf8_upgrade(sv);
XSprePUSH; PUSHi((IV)RETVAL);
}
XSRETURN(1);
}
XS(XS_utf8_downgrade)
{
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
{
SV * sv = ST(0);
const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
const bool RETVAL = sv_utf8_downgrade(sv, failok);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_utf8_native_to_unicode)
{
dXSARGS;
const UV uv = SvUV(ST(0));
if (items > 1)
Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
XSRETURN(1);
}
XS(XS_utf8_unicode_to_native)
{
dXSARGS;
const UV uv = SvUV(ST(0));
if (items > 1)
Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
XSRETURN(1);
}
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
dXSARGS;
SV *sv = SvRV(ST(0));
if (items == 1) {
if (SvREADONLY(sv))
XSRETURN_YES;
else
XSRETURN_NO;
}
else if (items == 2) {
if (SvTRUE(ST(1))) {
SvREADONLY_on(sv);
XSRETURN_YES;
}
else {
/* I hope you really know what you are doing. */
SvREADONLY_off(sv);
XSRETURN_NO;
}
}
XSRETURN_UNDEF; /* Can't happen. */
}
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
dXSARGS;
SV *sv = SvRV(ST(0));
if (items == 1)
XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
else if (items == 2) {
/* I hope you really know what you are doing. */
SvREFCNT(sv) = SvIV(ST(1));
XSRETURN_IV(SvREFCNT(sv));
}
XSRETURN_UNDEF; /* Can't happen. */
}
XS(XS_Internals_hv_clear_placehold)
{
dXSARGS;
HV *hv = (HV *) SvRV(ST(0));
if (items != 1)
Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)");
hv_clear_placeholders(hv);
XSRETURN(0);
}
XS(XS_Regexp_DESTROY)
{
PERL_UNUSED_ARG(cv);
}
XS(XS_PerlIO_get_layers)
{
dXSARGS;
if (items < 1 || items % 2 == 0)
Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
#ifdef USE_PERLIO
{
SV * sv;
GV * gv;
IO * io;
bool input = TRUE;
bool details = FALSE;
if (items > 1) {
SV **svp;
for (svp = MARK + 2; svp <= SP; svp += 2) {
SV **varp = svp;
SV **valp = svp + 1;
STRLEN klen;
const char *key = SvPV_const(*varp, klen);
switch (*key) {
case 'i':
if (klen == 5 && memEQ(key, "input", 5)) {
input = SvTRUE(*valp);
break;
}
goto fail;
case 'o':
if (klen == 6 && memEQ(key, "output", 6)) {
input = !SvTRUE(*valp);
break;
}
goto fail;
case 'd':
if (klen == 7 && memEQ(key, "details", 7)) {
details = SvTRUE(*valp);
break;
}
goto fail;
default:
fail:
Perl_croak(aTHX_
"get_layers: unknown argument '%s'",
key);
}
}
SP -= (items - 1);
}
sv = POPs;
gv = (GV*)sv;
if (!isGV(sv)) {
if (SvROK(sv) && isGV(SvRV(sv)))
gv = (GV*)SvRV(sv);
else if (SvPOKp(sv))
gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO);
}
if (gv && (io = GvIO(gv))) {
dTARGET;
AV* av = PerlIO_get_layers(aTHX_ input ?
IoIFP(io) : IoOFP(io));
I32 i;
I32 last = av_len(av);
I32 nitem = 0;
for (i = last; i >= 0; i -= 3) {
SV **namsvp;
SV **argsvp;
SV **flgsvp;
bool namok, argok, flgok;
namsvp = av_fetch(av, i - 2, FALSE);
argsvp = av_fetch(av, i - 1, FALSE);
flgsvp = av_fetch(av, i, FALSE);
namok = namsvp && *namsvp && SvPOK(*namsvp);
argok = argsvp && *argsvp && SvPOK(*argsvp);
flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
if (details) {
XPUSHs(namok
? newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp))
: &PL_sv_undef);
XPUSHs(argok
? newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp))
: &PL_sv_undef);
if (flgok)
XPUSHi(SvIVX(*flgsvp));
else
XPUSHs(&PL_sv_undef);
nitem += 3;
}
else {
if (namok && argok)
XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
*namsvp, *argsvp));
else if (namok)
XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf, *namsvp));
else
XPUSHs(&PL_sv_undef);
nitem++;
if (flgok) {
IV flags = SvIVX(*flgsvp);
if (flags & PERLIO_F_UTF8) {
XPUSHs(newSVpvn("utf8", 4));
nitem++;
}
}
}
}
SvREFCNT_dec(av);
XSRETURN(nitem);
}
}
#endif
XSRETURN(0);
}
XS(XS_Internals_hash_seed)
{
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_VAR(mark);
XSRETURN_UV(PERL_HASH_SEED);
}
XS(XS_Internals_rehash_seed)
{
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
PERL_UNUSED_ARG(cv);
PERL_UNUSED_VAR(mark);
XSRETURN_UV(PL_rehash_seed);
}
XS(XS_Internals_HvREHASH) /* Subject to change */
{
dXSARGS;
if (SvROK(ST(0))) {
const HV *hv = (HV *) SvRV(ST(0));
if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
if (HvREHASH(hv))
XSRETURN_YES;
else
XSRETURN_NO;
}
}
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: README.cygwin ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specially designed to be readable as is.
=head1 NAME
README.cygwin - Perl for Cygwin
=head1 SYNOPSIS
This document will help you configure, make, test and install Perl
on Cygwin. This document also describes features of Cygwin that will
affect how Perl behaves at runtime.
B<NOTE:> There are pre-built Perl packages available for Cygwin and a
version of Perl is provided in the normal Cygwin install. If you do
not need to customize the configuration, consider using one of those
packages.
=head1 PREREQUISITES FOR COMPILING PERL ON CYGWIN
=head2 Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it)
The Cygwin tools are ports of the popular GNU development tools for Win32
platforms. They run thanks to the Cygwin library which provides the UNIX
system calls and environment these programs expect. More information
about this project can be found at:
http://www.cygwin.com/
A recent net or commercial release of Cygwin is required.
At the time this document was last updated, Cygwin 1.5.2 was current.
=head2 Cygwin Configuration
While building Perl some changes may be necessary to your Cygwin setup so
that Perl builds cleanly. These changes are B<not> required for normal
Perl usage.
B<NOTE:> The binaries that are built will run on all Win32 versions.
They do not depend on your host system (Win9x/WinME, WinNT/Win2K)
or your Cygwin configuration (I<ntea>, I<ntsec>, binary/text mounts).
The only dependencies come from hard-coded pathnames like C</usr/local>.
However, your host system and Cygwin configuration will affect Perl's
runtime behavior (see L</"TEST">).
=over 4
=item * C<PATH>
Set the C<PATH> environment variable so that Configure finds the Cygwin
versions of programs. Any Windows directories should be removed or
moved to the end of your C<PATH>.
=item * I<nroff>
If you do not have I<nroff> (which is part of the I<groff> package),
Configure will B<not> prompt you to install I<man> pages.
=item * Permissions
On WinNT with either the I<ntea> or I<ntsec> C<CYGWIN> settings, directory
and file permissions may not be set correctly. Since the build process
creates directories and files, to be safe you may want to run a
C<chmod -R +w *> on the entire Perl source tree.
Also, it is a well known WinNT "feature" that files created by a login
that is a member of the I<Administrators> group will be owned by the
I<Administrators> group. Depending on your umask, you may find that you
can not write to files that you just created (because you are no longer
the owner). When using the I<ntsec> C<CYGWIN> setting, this is not an
issue because it "corrects" the ownership to what you would expect on
a UNIX system.
=back
=head1 CONFIGURE PERL ON CYGWIN
The default options gathered by Configure with the assistance of
F<hints/cygwin.sh> will build a Perl that supports dynamic loading
(which requires a shared F<libperl.dll>).
This will run Configure and keep a record:
./Configure 2>&1 | tee log.configure
If you are willing to accept all the defaults run Configure with B<-de>.
However, several useful customizations are available.
=head2 Stripping Perl Binaries on Cygwin
It is possible to strip the EXEs and DLLs created by the build process.
The resulting binaries will be significantly smaller. If you want the
binaries to be stripped, you can either add a B<-s> option when Configure
prompts you,
Any additional ld flags (NOT including libraries)? [none] -s
Any special flags to pass to gcc to use dynamic linking? [none] -s
Any special flags to pass to ld2 to create a dynamically loaded library?
[none] -s
or you can edit F<hints/cygwin.sh> and uncomment the relevant variables
near the end of the file.
=head2 Optional Libraries for Perl on Cygwin
Several Perl functions and modules depend on the existence of
some optional libraries. Configure will find them if they are
installed in one of the directories listed as being used for library
searches. Pre-built packages for most of these are available from
the Cygwin installer.
=over 4
=item * C<-lcrypt>
The crypt package distributed with Cygwin is a Linux compatible 56-bit
DES crypt port by Corinna Vinschen.
Alternatively, the crypt libraries in GNU libc have been ported to Cygwin.
The DES based Ultra Fast Crypt port was done by Alexey Truhan:
ftp://ftp.uni-erlangen.de/pub/pc/gnuwin32/cygwin/porters/Okhapkin_Sergey/cw32crypt-dist-0.tgz
NOTE: There are various export restrictions on DES implementations,
see the glibc README for more details.
The MD5 port was done by Andy Piper:
ftp://ftp.uni-erlangen.de/pub/pc/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz
=item * C<-lgdbm> (C<use GDBM_File>)
GDBM is available for Cygwin.
NOTE: The GDBM library only works on NTFS partitions.
=item * C<-ldb> (C<use DB_File>)
BerkeleyDB is available for Cygwin.
NOTE: The BerkeleyDB library only completely works on NTFS partitions.
=item * C<-lcygipc> (C<use IPC::SysV>)
A port of SysV IPC is available for Cygwin.
NOTE: This has B<not> been extensively tested. In particular,
C<d_semctl_semun> is undefined because it fails a Configure test
and on Win9x the I<shm*()> functions seem to hang. It also creates
a compile time dependency because F<perl.h> includes F<<sys/ipc.h>>
and F<<sys/sem.h>> (which will be required in the future when compiling
CPAN modules). CURRENTLY NOT SUPPORTED!
=item * C<-lutil>
Included with the standard Cygwin netrelease is the inetutils package
which includes libutil.a.
=back
=head2 Configure-time Options for Perl on Cygwin
The F<INSTALL> document describes several Configure-time options. Some of
these will work with Cygwin, others are not yet possible. Also, some of
these are experimental. You can either select an option when Configure
prompts you or you can define (undefine) symbols on the command line.
=over 4
=item * C<-Uusedl>
Undefining this symbol forces Perl to be compiled statically.
=item * C<-Uusemymalloc>
By default Perl uses the C<malloc()> included with the Perl source. If you
want to force Perl to build with the system C<malloc()> undefine this symbol.
=item * C<-Uuseperlio>
Undefining this symbol disables the PerlIO abstraction. PerlIO is now the
default; it is not recommended to disable PerlIO.
=item * C<-Dusemultiplicity>
Multiplicity is required when embedding Perl in a C program and using
more than one interpreter instance. This works with the Cygwin port.
=item * C<-Duse64bitint>
By default Perl uses 32 bit integers. If you want to use larger 64
bit integers, define this symbol.
=item * C<-Duselongdouble>
I<gcc> supports long doubles (12 bytes). However, several additional
long double math functions are necessary to use them within Perl
(I<{atan2, cos, exp, floor, fmod, frexp, isnan, log, modf, pow, sin, sqrt}l,
strtold>).
These are B<not> yet available with Cygwin.
=item * C<-Dusethreads>
POSIX threads are implemented in Cygwin, define this symbol if you want
a threaded perl.
=item * C<-Duselargefiles>
Cygwin uses 64-bit integers for internal size and position calculations,
this will be correctly detected and defined by Configure.
=item * C<-Dmksymlinks>
Use this to build perl outside of the source tree. This works with Cygwin.
Details can be found in the F<INSTALL> document. This is the recommended
way to build perl from sources.
=back
=head2 Suspicious Warnings on Cygwin
You may see some messages during Configure that seem suspicious.
=over 4
=item * I<dlsym()>
I<ld2> is needed to build dynamic libraries, but it does not exist
when C<dlsym()> checking occurs (it is not created until C<make> runs).
You will see the following message:
Checking whether your C<dlsym()> needs a leading underscore ...
ld2: not found
I can't compile and run the test program.
I'm guessing that dlsym doesn't need a leading underscore.
Since the guess is correct, this is not a problem.
=item * Win9x and C<d_eofnblk>
Win9x does not correctly report C<EOF> with a non-blocking read on a
closed pipe. You will see the following messages:
But it also returns -1 to signal EOF, so be careful!
WARNING: you can't distinguish between EOF and no data!
*** WHOA THERE!!! ***
The recommended value for $d_eofnblk on this machine was "define"!
Keep the recommended value? [y]
At least for consistency with WinNT, you should keep the recommended
value.
=item * Compiler/Preprocessor defines
The following error occurs because of the Cygwin C<#define> of
C<_LONG_DOUBLE>:
Guessing which symbols your C compiler and preprocessor define...
try.c:<line#>: missing binary operator
This failure does not seem to cause any problems. With older gcc
versions, "parse error" is reported instead of "missing binary
operator".
=back
=head1 MAKE ON CYGWIN
Simply run I<make> and wait:
make 2>&1 | tee log.make
=head2 Errors on Cygwin
Errors like these are normal:
...
make: [extra.pods] Error 1 (ignored)
...
make: [extras.make] Error 1 (ignored)
=head2 ld2 on Cygwin
During C<make>, I<ld2> will be created and installed in your $installbin
directory (where you said to put public executables). It does not
wait until the C<make install> process to install the I<ld2> script,
this is because the remainder of the C<make> refers to I<ld2> without
fully specifying its path and does this from multiple subdirectories.
The assumption is that $installbin is in your current C<PATH>. If this
is not the case C<make> will fail at some point. If this happens,
just manually copy I<ld2> from the source directory to somewhere in
your C<PATH>.
=head1 TEST ON CYGWIN
There are two steps to running the test suite:
make test 2>&1 | tee log.make-test
cd t;./perl harness 2>&1 | tee ../log.harness
The same tests are run both times, but more information is provided when
running as C<./perl harness>.
Test results vary depending on your host system and your Cygwin
configuration. If a test can pass in some Cygwin setup, it is always
attempted and explainable test failures are documented. It is possible
for Perl to pass all the tests, but it is more likely that some tests
will fail for one of the reasons listed below.
=head2 File Permissions on Cygwin
UNIX file permissions are based on sets of mode bits for
{read,write,execute} for each {user,group,other}. By default Cygwin
only tracks the Win32 read-only attribute represented as the UNIX file
user write bit (files are always readable, files are executable if they
have a F<.{com,bat,exe}> extension or begin with C<#!>, directories are
always readable and executable). On WinNT with the I<ntea> C<CYGWIN>
setting, the additional mode bits are stored as extended file attributes.
On WinNT with the I<ntsec> C<CYGWIN> setting, permissions use the standard
WinNT security descriptors and access control lists. Without one of
these options, these tests will fail (listing not updated yet):
Failed Test List of failed
------------------------------------
io/fs.t 5, 7, 9-10
lib/anydbm.t 2
lib/db-btree.t 20
lib/db-hash.t 16
lib/db-recno.t 18
lib/gdbm.t 2
lib/ndbm.t 2
lib/odbm.t 2
lib/sdbm.t 2
op/stat.t 9, 20 (.tmp not an executable extension)
=head2 NDBM_File and ODBM_File do not work on FAT filesystems
Do not use NDBM_File or ODBM_File on FAT filesystem. They can be
built on a FAT filesystem, but many tests will fail:
../ext/NDBM_File/ndbm.t 13 3328 71 59 83.10% 1-2 4 16-71
../ext/ODBM_File/odbm.t 255 65280 ?? ?? % ??
../lib/AnyDBM_File.t 2 512 12 2 16.67% 1 4
../lib/Memoize/t/errors.t 0 139 11 5 45.45% 7-11
../lib/Memoize/t/tie_ndbm.t 13 3328 4 4 100.00% 1-4
run/fresh_perl.t 97 1 1.03% 91
If you intend to run only on FAT (or if using AnyDBM_File on FAT),
run Configure with the -Ui_ndbm and -Ui_dbm options to prevent
NDBM_File and ODBM_File being built.
With NTFS (and CYGWIN=ntsec), there should be no problems even if
perl was built on FAT.
=head2 C<fork()> failures in io_* tests
A C<fork()> failure may result in the following tests failing:
ext/IO/lib/IO/t/io_multihomed.t
ext/IO/lib/IO/t/io_sock.t
ext/IO/lib/IO/t/io_unix.t
See comment on fork in L<Miscellaneous> below.
=head1 Specific features of the Cygwin port
=head2 Script Portability on Cygwin
Cygwin does an outstanding job of providing UNIX-like semantics on top of
Win32 systems. However, in addition to the items noted above, there are
some differences that you should know about. This is a very brief guide
to portability, more information can be found in the Cygwin documentation.
=over 4
=item * Pathnames
Cygwin pathnames can be separated by forward (F</>) or backward (F<\\>)
slashes. They may also begin with drive letters (F<C:>) or Universal
Naming Codes (F<//UNC>). DOS device names (F<aux>, F<con>, F<prn>,
F<com*>, F<lpt?>, F<nul>) are invalid as base filenames. However, they
can be used in extensions (e.g., F<hello.aux>). Names may contain all
printable characters except these:
: * ? " < > |
File names are case insensitive, but case preserving. A pathname that
contains a backslash or drive letter is a Win32 pathname (and not subject
to the translations applied to POSIX style pathnames).
=item * Text/Binary
When a file is opened it is in either text or binary mode. In text mode
a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default
mode for an C<open()> is determined by the mode of the mount that underlies
the file. Perl provides a C<binmode()> function to set binary mode on files
that otherwise would be treated as text. C<sysopen()> with the C<O_TEXT>
flag sets text mode on files that otherwise would be treated as binary:
sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT)
C<lseek()>, C<tell()> and C<sysseek()> only work with files opened in binary
mode.
The text/binary issue is covered at length in the Cygwin documentation.
=item * PerlIO
PerlIO overrides the default Cygwin Text/Binary behaviour. A file will
always treated as binary, regardless which mode of the mount it lives on,
just like it is in UNIX. So CR/LF translation needs to be requested in
either the C<open()> call like this:
open(FH, ">:crlf", "out.txt");
which will do conversion from LF to CR/LF on the output, or in the
environment settings (add this to your .bashrc):
export PERLIO=crlf
which will pull in the crlf PerlIO layer which does LF -> CRLF conversion
on every output generated by perl.
=item * F<.exe>
The Cygwin C<stat()>, C<lstat()> and C<readlink()> functions make the F<.exe>
extension transparent by looking for F<foo.exe> when you ask for F<foo>
(unless a F<foo> also exists). Cygwin does not require a F<.exe>
extension, but I<gcc> adds it automatically when building a program.
However, when accessing an executable as a normal file (e.g., I<cp>
in a makefile) the F<.exe> is not transparent. The I<install> included
with Cygwin automatically appends a F<.exe> when necessary.
=item * cygwin vs. windows process ids
Cygwin processes have their own pid, which is different from the
underlying windows pid. Most posix compliant Proc functions expect
the cygwin pid, but several Win32::Process functions expect the
winpid. E.g. C<$$> is the cygwin pid of F</usr/bin/perl>, which is not
the winpid. Use C<Cygwin::winpid_to_pid()> and C<Cygwin::winpid_to_pid()>
to translate between them.
=item * C<chown()>
On WinNT C<chown()> can change a file's user and group IDs. On Win9x C<chown()>
is a no-op, although this is appropriate since there is no security model.
=item * Miscellaneous
File locking using the C<F_GETLK> command to C<fcntl()> is a stub that
returns C<ENOSYS>.
Win9x can not C<rename()> an open file (although WinNT can).
The Cygwin C<chroot()> implementation has holes (it can not restrict file
access by native Win32 programs).
Inplace editing C<perl -i> of files doesn't work without doing a backup
of the file being edited C<perl -i.bak> because of windowish restrictions,
therefore Perl adds the suffix C<.bak> automatically if you use C<perl -i>
without specifying a backup extension.
Using C<fork()> after loading multiple dlls may fail with an internal cygwin
error like the following:
C:\CYGWIN\BIN\PERL.EXE: *** couldn't allocate memory 0x10000(4128768) for 'C:\CYGWIN\LIB\PERL5\5.6.1\CYGWIN-MULTI\AUTO\SOCKET\SOCKET.DLL' alignment, Win32 error 8
200 [main] perl 377147 sync_with_child: child -395691(0xB8) died before initialization with status code 0x1
1370 [main] perl 377147 sync_with_child: *** child state child loading dlls
Use the rebase utility to resolve the conflicting dll addresses. The
rebase package is included in the Cygwin netrelease. Use setup.exe from
F<http://www.cygwin.com/setup.exe> to install it and run rebaseall.
=back
=head2 Prebuilt methods:
=over 4
=item C<Cwd::cwd>
Returns current working directory.
=item C<Cygwin::pid_to_winpid>
Translates a cygwin pid to the corresponding Windows pid (which may or
may not be the same).
=item C<Cygwin::winpid_to_pid>
Translates a Windows pid to the corresponding cygwin pid (if any).
=back
=head1 INSTALL PERL ON CYGWIN
This will install Perl, including I<man> pages.
make install 2>&1 | tee log.make-install
NOTE: If C<STDERR> is redirected C<make install> will B<not> prompt
you to install I<perl> into F</usr/bin>.
You may need to be I<Administrator> to run C<make install>. If you
are not, you must have write access to the directories in question.
Information on installing the Perl documentation in HTML format can be
found in the F<INSTALL> document.
=head1 MANIFEST ON CYGWIN
These are the files in the Perl release that contain references to Cygwin.
These very brief notes attempt to explain the reason for all conditional
code. Hopefully, keeping this up to date will allow the Cygwin port to
be kept as clean as possible (listing not updated yet).
=over 4
=item Documentation
INSTALL README.cygwin README.win32 MANIFEST
Changes Changes5.005 Changes5.004 Changes5.6
pod/perl.pod pod/perlport.pod pod/perlfaq3.pod
pod/perldelta.pod pod/perl5004delta.pod pod/perl56delta.pod
pod/perlhist.pod pod/perlmodlib.pod perl/buildtoc pod/perltoc.pod
=item Build, Configure, Make, Install
cygwin/Makefile.SHs
cygwin/ld2.in
cygwin/perlld.in
ext/IPC/SysV/hints/cygwin.pl
ext/NDBM_File/hints/cygwin.pl
ext/ODBM_File/hints/cygwin.pl
hints/cygwin.sh
Configure - help finding hints from uname,
shared libperl required for dynamic loading
Makefile.SH - linklibperl
Porting/patchls - cygwin in port list
installman - man pages with :: translated to .
installperl - install dll/ld2/perlld, install to pods
makedepend.SH - uwinfix
=item Tests
t/io/tell.t - binmode
t/lib/b.t - ignore Cwd from os_extras
t/lib/glob-basic.t - Win32 directory list access differs from read mode
t/op/magic.t - $^X/symlink WORKAROUND, s/.exe//
t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk
(cache manager sometimes preserves ctime of file
previously created and deleted), no -u (setuid)
t/lib/cygwin.t - builtin cygwin function tests
=item Compiled Perl Source
EXTERN.h - __declspec(dllimport)
XSUB.h - __declspec(dllexport)
cygwin/cygwin.c - os_extras (getcwd, spawn, Cygwin::winpid_to_pid,
Cygwin::pid_to_winpid)
perl.c - os_extras
perl.h - binmode
doio.c - win9x can not rename a file when it is open
pp_sys.c - do not define h_errno, pp_system with spawn
util.c - use setenv
=item Compiled Module Source
ext/POSIX/POSIX.xs - tzname defined externally
ext/SDBM_File/sdbm/pair.c
- EXTCONST needs to be redefined from EXTERN.h
ext/SDBM_File/sdbm/sdbm.c
- binary open
=item Perl Modules/Scripts
lib/Cwd.pm - hook to internal Cwd::cwd
lib/ExtUtils/MakeMaker.pm
- require MM_Cygwin.pm
lib/ExtUtils/MM_Cygwin.pm
- canonpath, cflags, manifypods, perl_archive
lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1
lib/File/Spec/Unix.pm - preserve //unc
lib/File/Temp.pm - no directory sticky bit
lib/perl5db.pl - use stdin not /dev/tty
utils/perldoc.PL - version comment
=back
=head1 BUGS ON CYGWIN
Support for swapping real and effective user and group IDs is incomplete.
On WinNT Cygwin provides C<setuid()>, C<seteuid()>, C<setgid()> and C<setegid()>.
However, additional Cygwin calls for manipulating WinNT access tokens
and security contexts are required.
=head1 AUTHORS
Charles Wilson <cwilson at ece.gatech.edu>,
Eric Fifer <egf7 at columbia.edu>,
alexander smishlajev <als at turnhere.com>,
Steven Morlock <newspost at morlock.net>,
Sebastien Barre <Sebastien.Barre at utc.fr>,
Teun Burgers <burgers at ecn.nl>,
Gerrit P. Haase <gp at familiehaase.de>.
=head1 HISTORY
Last updated: 2005-02-11
--- NEW FILE: Makefile.SH ---
#! /bin/sh
case $PERL_CONFIG_SH in
'')
if test -f config.sh
then TOP=.
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
# H.Merijn Brand [17 Feb 2004]
# This comment is just to ensure that Configure will find variables that
# are removed/replaced in patches on blead, but are still needed in the
# 5.8.x, 5.6.x and 5.005.x maintainance tracks.
# metaconfig -m will scan all .SH files on this level (not deeper), and
# not in x2p and other subfolders. This file is as good as any .SH
# patch references
[...1399 lines suppressed...]
xxx="$xxx a2p.h"
fi
fi
cd ..
fi
;;
vmesa)
# Do nothing in VM/ESA.
;;
*)
echo "'$osname' is an EBCDIC system I don't know that well." >&4
;;
esac
case "$xxx" in
'') echo "No parser files were regenerated. That's okay." >&2 ;;
esac
;;
esac
# ex: set ts=8 sts=4 sw=4 noet:
--- NEW FILE: README.vos ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specially designed to be readable as is.
=head1 NAME
README.vos - Perl for Stratus VOS
=head1 SYNOPSIS
This file contains notes for building perl on the Stratus VOS
operating system. Perl is a scripting or macro language that is
popular on many systems. See L<perlbook> for a number of good
books on Perl.
These are instructions for building Perl from source. Most people can
simply download a pre-compiled distribution from the VOS anonymous FTP
site. If you are running VOS Release 14.2.0 or earlier, download Perl
from ftp://ftp.stratus.com/pub/vos/posix/alpha/alpha.html If you are
running VOS Release 14.3.0 or later, download Perl from
ftp://ftp.stratus.com/pub/vos/posix/ga/ga.html Instructions for
unbundling the Perl distribution file are at
ftp://ftp.stratus.com/pub/vos/utility/utility.html
If you are running VOS Release 14.4.1 or later, you can obtain a
pre-compiled, supported copy of perl by purchasing Release 2.0.1
(or later) of the VOS GNU C++ and GNU Tools product from Stratus
Technologies.
=head2 Multiple methods to build perl for VOS
If you elect to build perl from its source code, you have several
different ways that you can build perl. The method that you use
depends on the version of VOS that you are using and on the
architecture of your Stratus hardware platform.
=over 5
=item 1
If you have a Stratus XA2000 (Motorola 68k-based) platform, you
must build perl using the alpha version of VOS POSIX support and
using the VOS Standard C Cross-compiler. You must build perl on
VOS Release 14.1.0 (or later) on an XA/R or Continuum platform.
This version of perl is properly called "miniperl" because it
does not contain the complete perl functionality.
You must build perl with the compile_perl.cm command macro found
in the vos subdirectory.
=item 2
If you have a Stratus XA/R (Intel i860-based) platform, you must
build perl using the alpha version of VOS POSIX support and using
the VOS Standard C compiler or cross-compiler. You must build
perl on VOS Release 14.1.0 (or later) on an XA/R or Continuum
platform.
This version of perl is properly called "miniperl" because it
does not contain the complete perl functionality.
You must build perl with the compile_perl.cm command macro found
in the vos subdirectory.
=item 3
If you have a Stratus Continuum (PA-RISC-based) platform that is
running a version of VOS earlier than VOS 14.3.0, you must build
perl using the alpha version of VOS POSIX support and using the
VOS Standard C compiler or cross-compiler. You must build perl
on VOS Release 14.1.0 (or later) on an XA/R or Continuum
platform.
This version of perl is properly called "miniperl" because it
does not contain the complete perl functionality.
You must build perl with the compile_perl.cm command macro found
in the vos subdirectory.
=item 4
If you have a Stratus Continuum (PA-RISC-based) platform that is
running VOS Release 14.3.0 through VOS Release 14.4.1, you must
build perl using the generally-available version of VOS POSIX
support, and using either the VOS Standard C compiler or the VOS
GNU C compiler. You must build perl on VOS Release 14.3.0 (or
later) on a Continuum platform.
This version of perl is properly called "miniperl" because it
does not contain the complete perl functionality.
You must build perl with the compile_perl.cm command macro found
in the vos subdirectory.
=item 5
If you have a Stratus Continuum (PA-RISC-based) platform that is
running VOS Release 14.5.0 or later, you can either use the
previous method to build "miniperl" or you can build "full
perl", which contains the complete functionality of perl. I
strongly recommend that you build full perl. To build full
perl, you must use the generally-available version of VOS POSIX
support. You must use the VOS GNU C compiler and the VOS GNU
C/C++ and GNU Tools Release 2.0.1 (or later) product. You must
build full perl on VOS Release 14.5.0 (or later) on a Continuum
platform.
You must build full perl with the compile_full_perl.cm command
macro found in the vos subdirectory.
=back
=head2 Stratus POSIX Support
Note that there are two different implementations of POSIX.1
support on VOS. There is an alpha version of POSIX that is
available from the Stratus anonymous ftp site
( ftp://ftp.stratus.com/pub/vos/posix/alpha/alpha.html ). There
is a generally-available version of POSIX that comes with VOS
Release 14.3.0 or higher. This port of POSIX will compile and
bind with either version of POSIX.
Most of the Perl features should work on VOS regardless of which
version of POSIX that you are using. However, the alpha version
of POSIX is missing a number of key functions, and therefore any
attempt by perl.pm to call the following unimplemented POSIX
functions will result in an error message and an immediate and
fatal call to the VOS debugger. They are "dup", "fork", and
"waitpid". The lack of these functions prevents you from
starting VOS commands and grabbing their output in perl. The
workaround is to run the commands outside of perl, then have perl
process the output file. These functions are all available in
the generally-available version of POSIX.
=head1 INSTALLING PERL IN VOS
=head2 Compiling Perl 5 on VOS
Before you can build Perl 5 on VOS, you need to have or acquire the
following additional items.
=over 5
=item 1
The VOS Standard C Compiler (or the VOS Standard C
Cross-Compiler) and the VOS C Runtime. If you are using
the generally-available version of POSIX support, you may
instead use the VOS GNU C/C++ Compiler. These are
standard Stratus products.
=item 2
Either the VOS OS TCP/IP or STCP product set. If you are
building with the alpha version of POSIX you need the OS
TCP/IP product set. If you are building with the
generally-available version of POSIX you need the STCP
product set. These are standard Stratus products.
=item 3
Either the alpha or generally-available version of the VOS
POSIX.1 environment.
The alpha version of POSIX.1 support is available on the
Stratus FTP site. Login anonymously to ftp.stratus.com and
get the file /pub/vos/posix/alpha/posix.save.evf.gz in
binary file-transfer mode. Or use the Uniform Resource
Locator (URL)
ftp://ftp.stratus.com/pub/vos/posix/alpha/posix.save.evf.gz from
your web browser. Instructions for unbundling this file
are at ftp://ftp.stratus.com/pub/vos/utility/utility.html
This is NOT a standard Stratus product.
In VOS Release 14.3.0, the generally-available version of
POSIX.1 support is bundled with the VOS Standard C compiler
(or Standard C Cross-Compiler). In VOS Release 14.4.0 or
higher, it is also bundled with the VOS C Runtime. These
are standard Stratus products.
=item 4
You must compile this version of Perl 5 on VOS Release
14.1.0 or higher because some of the perl source files
contain more than 32,767 source lines. Due to VOS
release-compatibility rules, this port of perl may not
execute on VOS Release 12 or earlier.
=item 5
If you are using the generally-available version of VOS POSIX
support, then you should also acquire the VOS GNU C/C++ Compiler
and GNU Tools product. When perl is built with this version of
POSIX support, it assumes that it can find "bash", "sed" and
other POSIX-compatible commands in the directory
/system/gnu_library/bin.
=back
To build perl using the supplied VOS command macros, change to
the "vos" subdirectory and type the command "compile_perl
-processor X", where X is the processor type (mc68020, i80860,
pa7100, pa8000) that you wish to use. Note that the
generally-available version of POSIX.1 support is not available
for the mc68020 or i80860 processors.
Use the "-version alpha" control argument to build perl with
the alpha version of POSIX support, and use the "-version
ga" control argument to build it with the
generally-available version of POSIX. The default is "ga".
Use the "-compiler cc" control argument to build perl with
the VOS Standard C compiler. Use the "-compiler gcc"
control argument to build it with the GNU GCC compiler. The
default is "cc".
You must have purchased the VOS Standard C Cross Compiler in
order to compile perl for a processor type that is different
from the processor type of the module.
Note that code compiled for the pa7100 processor type can
execute on the PA7100, PA8000, PA8500 and PA8600 processors, and
that code compiled for the pa8000 processor type can execute on
the PA8000, PA8500 and PA8600 processors.
To build full perl using the supplied Configure script and
makefiles, change to the "vos" subdirectory and type the command
"compile_full_perl" or "start_process compile_full_perl". This
will configure, build, and test perl.
=head2 Installing Perl 5 on VOS
=over 4
=item 1
If you have built perl using the Configure script, ensure that
you have modify permission to C<< >system>ported >> and type
gmake install
=item 2
If you have built perl using any of the other methods, type
install_perl -processor PROCESSOR -name NAME
where PROCESSOR is mc68020, i80860, pa7100, or pa8000, as
appropriate, and NAME is perl or perl5, according to which name
you wish to use.
This command macro will install perl and all of its related
files in the proper directories.
=item 3
While there are currently no architecture-specific
extensions or modules distributed with perl, the following
directories can be used to hold such files:
>system>ported>lib>perl5>5.8.0>68k
>system>ported>lib>perl5>5.8.0>860
>system>ported>lib>perl5>5.8.0>7100
>system>ported>lib>perl5>5.8.0>8000
=item 4
Site-specific perl extensions and modules can be installed in one of
two places. Put architecture-independent files into:
>system>ported>lib>perl5>site_perl>5.8.0
Put site-specific architecture-dependent files into one of the
following directories:
>system>ported>lib>perl5>site_perl>5.8.0>68k
>system>ported>lib>perl5>site_perl>5.8.0>860
>system>ported>lib>perl5>site_perl>5.8.0>7100
>system>ported>lib>perl5>site_perl>5.8.0>8000
=item 5
You can examine the @INC variable from within a perl program
to see the order in which Perl searches these directories.
=back
=head1 USING PERL IN VOS
=head2 Unimplemented Features of Perl on VOS
If perl is built with the alpha version of VOS POSIX.1 support
and if it attempts to call an unimplemented VOS POSIX.1
function, it will print a fatal error message and enter the VOS
debugger. This error is not recoverable. See vos_dummies.c for
a list of the unimplemented POSIX.1 functions. To see what
functions are unimplemented and what the error message looks
like, compile and execute "test_vos_dummies.c".
=head2 Restrictions of Perl on VOS
This port of Perl version 5 to VOS prefers Unix-style,
slash-separated pathnames over VOS-style greater-than-separated
pathnames. VOS-style pathnames should work in most contexts, but
if you have trouble, replace all greater-than characters by slash
characters. Because the slash character is used as a pathname
delimiter, Perl cannot process VOS pathnames containing a slash
character in a directory or file name; these must be renamed.
This port of Perl also uses Unix-epoch date values internally.
As long as you are dealing with ASCII character string
representations of dates, this should not be an issue. The
supported epoch is January 1, 1980 to January 17, 2038.
See the file pod/perlport.pod for more information about the VOS
port of Perl.
=head2 Handling of underflow and overflow
Prior to VOS Release 14.7.0, VOS does not support automatically
mapping overflowed floating-point values to +infinity, nor
automatically mapping underflowed floating-point values to zero,
unlike many other platforms. The Perl pack function has been
modified to perform such mapping in software on VOS. Performing
other floating-point computations that underflow or overflow
will probably result in SIGFPE. Don't push your luck.
As of VOS Release 14.7.0, the VOS POSIX runtime sets up the
PA-RISC hardware floating-point status register so that the
overflow and underflow exceptions do not trap, but instead
automatically convert the result to infinity or zero, as
appropriate. As of this writing, there are still floating-point
operations that can trap, for example, subtracting two infinite
values. This is recorded as suggestion posix-1022, which is not
yet fixed.
=head1 TEST STATUS
When Perl 5.8.3 is built using the native build process on VOS
Release 14.7.0 and GNU C++/GNU Tools 2.0.2a, all but three
attempted tests either pass or result in TODO (ignored)
failures. The tests that fail are:
t/io/tell.t, test 28
t/op/pack.t, test 39
lib/Net/ing/t/450_service.t, test 8
=head1 SUPPORT STATUS
I'm offering this port "as is". You can ask me questions, but I
can't guarantee I'll be able to answer them. There are some
excellent books available on the Perl language; consult a book
seller.
If you want a supported version of perl for VOS, purchase the
VOS GNU C++ and GNU Tools Release 2.0.1 (or later) product from
Stratus Technologies, along with a support contract (or from
anyone else who will sell you support).
=head1 AUTHOR
Paul Green (Paul.Green at stratus.com)
=head1 LAST UPDATE
January 15, 2004
=cut
--- NEW FILE: warnings.h ---
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by warnings.pl
Any changes made here will be lost!
*/
#define Off(x) ((x) / 8)
#define Bit(x) (1 << ((x) % 8))
#define IsSet(a, x) ((a)[Off(x)] & Bit(x))
#define G_WARN_OFF 0 /* $^W == 0 */
#define G_WARN_ON 1 /* -w flag and $^W != 0 */
#define G_WARN_ALL_ON 2 /* -W flag */
#define G_WARN_ALL_OFF 4 /* -X flag */
#define G_WARN_ONCE 8 /* set if 'once' ever enabled */
#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
#define pWARN_STD Nullsv
#define pWARN_ALL (Nullsv+1) /* use warnings 'all' */
#define pWARN_NONE (Nullsv+2) /* no warnings 'all' */
#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
(x) == pWARN_NONE)
/* Warnings Categories added in Perl 5.008 */
#define WARN_ALL 0
#define WARN_CLOSURE 1
#define WARN_DEPRECATED 2
#define WARN_EXITING 3
#define WARN_GLOB 4
#define WARN_IO 5
#define WARN_CLOSED 6
#define WARN_EXEC 7
#define WARN_LAYER 8
#define WARN_NEWLINE 9
#define WARN_PIPE 10
#define WARN_UNOPENED 11
#define WARN_MISC 12
#define WARN_NUMERIC 13
#define WARN_ONCE 14
#define WARN_OVERFLOW 15
#define WARN_PACK 16
#define WARN_PORTABLE 17
#define WARN_RECURSION 18
#define WARN_REDEFINE 19
#define WARN_REGEXP 20
#define WARN_SEVERE 21
#define WARN_DEBUGGING 22
#define WARN_INPLACE 23
#define WARN_INTERNAL 24
#define WARN_MALLOC 25
#define WARN_SIGNAL 26
#define WARN_SUBSTR 27
#define WARN_SYNTAX 28
#define WARN_AMBIGUOUS 29
#define WARN_BAREWORD 30
#define WARN_DIGIT 31
#define WARN_PARENTHESIS 32
#define WARN_PRECEDENCE 33
#define WARN_PRINTF 34
#define WARN_PROTOTYPE 35
#define WARN_QW 36
#define WARN_RESERVED 37
#define WARN_SEMICOLON 38
#define WARN_TAINT 39
#define WARN_THREADS 40
#define WARN_UNINITIALIZED 41
#define WARN_UNPACK 42
#define WARN_UNTIE 43
#define WARN_UTF8 44
#define WARN_VOID 45
#define WARN_Y2K 46
#define WARNsize 12
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0"
#define WARN_TAINTstring "\0\0\0\0\0\0\0\0\0\100\0\0"
#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet(SvPVX_const(c), 2*(x)))
#define isWARNf_on(c,x) (IsSet(SvPVX_const(c), 2*(x)+1))
#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
#define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
#define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
#define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
#define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
#define packWARN(a) (a )
#define packWARN2(a,b) ((a) | ((b)<<8) )
#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
#define unpackWARN1(x) ((x) & 0xFF)
#define unpackWARN2(x) (((x) >>8) & 0xFF)
#define unpackWARN3(x) (((x) >>16) & 0xFF)
#define unpackWARN4(x) (((x) >>24) & 0xFF)
#define ckDEAD(x) \
( ! specialWARN(PL_curcop->cop_warnings) && \
( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
/* end of file warnings.h */
/* ex: set ro: */
--- NEW FILE: doio.c ---
/* doio.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "Far below them they saw the white waters pour into a foaming bowl, and
* then swirl darkly about a deep oval basin in the rocks, until they found
* their way out again through a narrow gate, and flowed away, fuming and
* chattering, into calmer and more level reaches."
*/
/* This file contains functions that do the actual I/O on behalf of ops.
* For example, pp_print() calls the do_print() function in this file for
[...2448 lines suppressed...]
#endif /* !CSH */
#endif /* !DOSISH */
#endif /* MACOS_TRADITIONAL */
(void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
FALSE, O_RDONLY, 0, Nullfp);
fp = IoIFP(io);
#endif /* !VMS */
LEAVE;
return fp;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: unixish.h ---
/* unixish.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* The following symbols are defined if your operating system supports
* functions by that name. All Unixes I know of support them, thus they
* are not checked by the configuration script, but are directly defined
* here.
*/
#ifndef PERL_MICRO
/* HAS_IOCTL:
* This symbol, if defined, indicates that the ioctl() routine is
* available to set I/O characteristics
*/
#define HAS_IOCTL /**/
/* HAS_UTIME:
* This symbol, if defined, indicates that the routine utime() is
* available to update the access and modification times of files.
*/
#define HAS_UTIME /**/
/* HAS_GROUP
* This symbol, if defined, indicates that the getgrnam() and
* getgrgid() routines are available to get group entries.
* The getgrent() has a separate definition, HAS_GETGRENT.
*/
#define HAS_GROUP /**/
/* HAS_PASSWD
* This symbol, if defined, indicates that the getpwnam() and
* getpwuid() routines are available to get password entries.
* The getpwent() has a separate definition, HAS_GETPWENT.
*/
#define HAS_PASSWD /**/
#define HAS_KILL
#define HAS_WAIT
#endif /* !PERL_MICRO */
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype) to insure
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
#undef USEMYBINMODE
/* Stat_t:
* This symbol holds the type used to declare buffers for information
* returned by stat(). It's usually just struct stat. It may be necessary
* to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
* information.
*/
#define Stat_t struct stat
/* USE_STAT_RDEV:
* This symbol is defined if this system has a stat structure declaring
* st_rdev
*/
#define USE_STAT_RDEV /**/
/* ACME_MESS:
* This symbol, if defined, indicates that error messages should be
* should be generated in a format that allows the use of the Acme
* GUI/editor's autofind feature.
*/
#undef ACME_MESS /**/
/* UNLINK_ALL_VERSIONS:
* This symbol, if defined, indicates that the program should arrange
* to remove all versions of a file if unlink() is called. This is
* probably only relevant for VMS.
*/
/* #define UNLINK_ALL_VERSIONS / **/
/* VMS:
* This symbol, if defined, indicates that the program is running under
* VMS. It is currently automatically set by cpps running under VMS,
* and is included here for completeness only.
*/
/* #define VMS / **/
/* ALTERNATE_SHEBANG:
* This symbol, if defined, contains a "magic" string which may be used
* as the first line of a Perl program designed to be executed directly
* by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
* begins with a character other then #, then Perl will only treat
* it as a command line if it finds the string "perl" in the first
* word; otherwise it's treated as the first line of code in the script.
* (IOW, Perl won't hand off to another interpreter via an alternate
* shebang sequence that might be legal Perl code.)
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
# include <signal.h>
#ifndef SIGABRT
# define SIGABRT SIGILL
#endif
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
#define ABORT() kill(PerlProc_getpid(),SIGABRT);
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
* but which outputs all of the bytes requested as a single stream (unlike
* fwrite() itself, which on some systems outputs several distinct records
* if the number_of_items parameter is >1).
*/
#define fwrite1 fwrite
#define Stat(fname,bufptr) stat((fname),(bufptr))
#define Fstat(fd,bufptr) fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
#ifndef PERL_SYS_INIT
# define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT MALLOC_INIT
#endif
#ifndef PERL_SYS_TERM
#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM
#endif
#define BIT_BUCKET "/dev/null"
#define dXSUB_SYS
#define USE_ENVIRON_ARRAY
--- NEW FILE: README.epoc ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specially designed to be readable as is.
=head1 NAME
README.epoc - Perl for EPOC
=head1 SYNOPSIS
Perl 5 README file for the EPOC Release 5 operating system.
=head1 INTRODUCTION
EPOC is an OS for palmtops and mobile phones. For more informations look at:
http://www.symbian.com/
This is a port of perl to the epocemx SDK by Eberhard Mattes, which
itself uses the SDK by symbian. Essentially epocemx it is a POSIX
look alike environment for the EPOC OS. For more information look at:
http://epocemx.sourceforge.net/
perl and epocemx runs on Epoc Release 5 machines: Psion 5mx, 5mx Pro,
Psion Revo, Psion Netbook and on the Ericsson M128. It may run on Epoc
Release 3 Hardware (Series 5 classic), too. For more information about
this hardware please refer to http://www.psion.com/
Vendors which like to have support for their devices are free to send
me a sample.
=head1 INSTALLING PERL ON EPOC
You can download a ready-to-install version from
http://www.oflebbe.de/oflebbe/perl/
You will need at least ~6MB free space in order to install and run perl.
Please install the emxusr.sis package from
http://epocemx.sourceforge.net/ first.
Install perl.sis on the EPOC machine. If you do not know how to do
that, consult your PsiWin documentation.
Perl itself and its standard library is using 4 MB disk space.
Unicode support and some other modules are left out. (For details,
please look into epoc/createpkg.pl). If you like to use these modules,
you are free to copy them from a current perl release.
=head1 STARTING PERL ON EPOC
Please use the epocemx shell to start perl. perl integrates with the
conventions of epocemx.
=head2 Editors on Epoc
A suitable text editor can be downloaded from symbian
http://www.symbian.com/developer/downloads/files/editor.zip
=head2 Features of Perl on Epoc
The built-in function EPOC::getcwd returns the current directory.
=head2 Restrictions of Perl on Epoc
Features are left out, because of restrictions of the POSIX support in
EPOC:
=over 4
=item *
socket IO is only implemented poorly. You can only use sysread and
syswrite on them. The commands read, write, print, <> do not work for
sockets. This may change iff epocemx supports sockets.
=item *
kill, alarm and signals. Do not try to use them. This may be
impossible to implement on EPOC.
=item *
select is missing.
=item *
binmode does not exist. (No CR LF to LF translation for text files)
=item *
EPOC does not handle the notion of current drive and current
directory very well (i.e. not at all, but it tries hard to emulate
one). See PATH.
=item *
Heap is limited to 4MB.
=item *
Dynamic loading is not implemented.
=back
=head2 Compiling Perl 5 on the EPOC cross compiling environment
Sorry, this is far too short.
=over 4
=item *
You will need the epocemx SDK from Eberhard Mattes.
=item *
Get the Perl sources from your nearest CPAN site.
=item *
Unpack the sources.
=item *
Build a native perl from this sources... Make sure to save the
miniperl executable as miniperl.native.
Start again from scratch
cp epoc/* .
./Configure -S
make
cp miniperl.native miniperl
touch miniperl.exe
make
perl createpkg.pl
emxsis perl.pkg perl.sis
=back
=head1 SUPPORT STATUS OF PERL ON EPOC
I'm offering this port "as is". You can ask me questions, but I can't
guarantee I'll be able to answer them. Since the port to epocemx is
quite new, please check the web for updates first.
Very special thanks to Eberhard Mattes for epocemx.
=head1 AUTHOR
Olaf Flebbe <olaf at oflebbe.de>
http://www.oflebbe.de/oflebbe/perl/
=head1 LAST UPDATE
2003-01-18
=cut
--- NEW FILE: Changes5.8 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
pod/perlhack.pod for the details.
For information on what's new in this release, see pod/perldelta.pod.
[The "CAST AND CREW" list has been moved to AUTHORS.]
NOTE: Each change entry shows the change number; who checked it into the
repository; when; description of the change; which branch the change
happened in; and the affected files. The file lists have a short symbolic
indicator:
! modified
+ added
- deleted
[...92132 lines suppressed...]
Log: rename Changes and perldelta.pod
Branch: perl
+> Changes5.6 pod/perl56delta.pod
- Changes pod/perldelta.pod
! MANIFEST
____________________________________________________________________________
[ 5902] By: gsar on 2000/03/28 01:59:14
Log: create maint-5.6 branch
Branch: maint-5.6/perl
+> (branch 1611 files)
____________________________________________________________________________
[ 5901] By: jhi on 2000/03/23 05:48:43
Log: Integrate with Sarathy.
Branch: cfgperl
!> Changes patchlevel.h pod/perlhist.pod pod/perltoc.pod
____________________________________________________________________________
[ 5900] By: gsar on 2000/03/23 05:42:43
Log: three guesses on what this is :-)
Branch: perl
! Changes
--- NEW FILE: utf8.h ---
/* utf8.h
*
* Copyright (C) 2000, 2001, 2002, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/* Use UTF-8 as the default script encoding?
* Turning this on will break scripts having non-UTF-8 binary
* data (such as Latin-1) in string literals. */
#ifdef USE_UTF8_SCRIPTS
# define USE_UTF8_IN_NAMES (!IN_BYTES)
#else
# define USE_UTF8_IN_NAMES (PL_hints & HINT_UTF8)
#endif
#ifdef EBCDIC
/* The equivalent of these macros but implementing UTF-EBCDIC
are in the following header file:
*/
#include "utfebcdic.h"
#else
START_EXTERN_C
#ifdef DOINIT
EXTCONST unsigned char PL_utf8skip[] = {
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus */
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus */
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, /* scripts */
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,6,6, /* cjk etc. */
7,13, /* Perl extended (not UTF-8). Up to 72bit allowed (64-bit + reserved). */
};
#else
EXTCONST unsigned char PL_utf8skip[];
#endif
END_EXTERN_C
#define UTF8SKIP(s) PL_utf8skip[*(const U8*)s]
/* Native character to iso-8859-1 */
#define NATIVE_TO_ASCII(ch) (ch)
#define ASCII_TO_NATIVE(ch) (ch)
/* Transform after encoding */
#define NATIVE_TO_UTF(ch) (ch)
#define UTF_TO_NATIVE(ch) (ch)
/* Transforms in wide UV chars */
#define UNI_TO_NATIVE(ch) (ch)
#define NATIVE_TO_UNI(ch) (ch)
/* Transforms in invariant space */
#define NATIVE_TO_NEED(enc,ch) (ch)
#define ASCII_TO_NEED(enc,ch) (ch)
/* As there are no translations avoid the function wrapper */
#define Perl_utf8n_to_uvchr Perl_utf8n_to_uvuni
#define Perl_uvchr_to_utf8 Perl_uvuni_to_utf8
/*
The following table is from Unicode 3.2.
Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte
U+0000..U+007F 00..7F
U+0080..U+07FF C2..DF 80..BF
U+0800..U+0FFF E0 A0..BF 80..BF
U+1000..U+CFFF E1..EC 80..BF 80..BF
U+D000..U+D7FF ED 80..9F 80..BF
U+D800..U+DFFF ******* ill-formed *******
U+E000..U+FFFF EE..EF 80..BF 80..BF
U+10000..U+3FFFF F0 90..BF 80..BF 80..BF
U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF
U+100000..U+10FFFF F4 80..8F 80..BF 80..BF
Note the A0..BF in U+0800..U+0FFF, the 80..9F in U+D000...U+D7FF,
the 90..BF in U+10000..U+3FFFF, and the 80...8F in U+100000..U+10FFFF.
The "gaps" are caused by legal UTF-8 avoiding non-shortest encodings:
it is technically possible to UTF-8-encode a single code point in different
ways, but that is explicitly forbidden, and the shortest possible encoding
should always be used (and that is what Perl does).
*/
/*
Another way to look at it, as bits:
Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte
0aaaaaaa 0aaaaaaa
00000bbbbbaaaaaa 110bbbbb 10aaaaaa
ccccbbbbbbaaaaaa 1110cccc 10bbbbbb 10aaaaaa
00000dddccccccbbbbbbaaaaaa 11110ddd 10cccccc 10bbbbbb 10aaaaaa
As you can see, the continuation bytes all begin with C<10>, and the
leading bits of the start byte tell how many bytes the are in the
encoded character.
*/
#define UNI_IS_INVARIANT(c) (((UV)c) < 0x80)
#define UTF8_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_UTF(c))
#define NATIVE_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_ASCII(c))
#define UTF8_IS_START(c) (((U8)c) >= 0xc0 && (((U8)c) <= 0xfd))
#define UTF8_IS_CONTINUATION(c) (((U8)c) >= 0x80 && (((U8)c) <= 0xbf))
#define UTF8_IS_CONTINUED(c) (((U8)c) & 0x80)
#define UTF8_IS_DOWNGRADEABLE_START(c) (((U8)c & 0xfc) == 0xc0)
#define UTF_START_MARK(len) ((len > 7) ? 0xFF : (0xFE << (7-len)))
#define UTF_START_MASK(len) ((len >= 7) ? 0x00 : (0x1F >> (len-2)))
#define UTF_CONTINUATION_MARK 0x80
#define UTF_ACCUMULATION_SHIFT 6
#define UTF_CONTINUATION_MASK ((U8)0x3f)
#define UTF8_ACCUMULATE(old, new) (((old) << UTF_ACCUMULATION_SHIFT) | (((U8)new) & UTF_CONTINUATION_MASK))
#define UTF8_EIGHT_BIT_HI(c) ((((U8)(c))>>UTF_ACCUMULATION_SHIFT)|UTF_START_MARK(2))
#define UTF8_EIGHT_BIT_LO(c) (((((U8)(c)))&UTF_CONTINUATION_MASK)|UTF_CONTINUATION_MARK)
#ifdef HAS_QUAD
#define UNISKIP(uv) ( (uv) < 0x80 ? 1 : \
(uv) < 0x800 ? 2 : \
(uv) < 0x10000 ? 3 : \
(uv) < 0x200000 ? 4 : \
(uv) < 0x4000000 ? 5 : \
(uv) < 0x80000000 ? 6 : \
(uv) < UTF8_QUAD_MAX ? 7 : 13 )
#else
/* No, I'm not even going to *TRY* putting #ifdef inside a #define */
#define UNISKIP(uv) ( (uv) < 0x80 ? 1 : \
(uv) < 0x800 ? 2 : \
(uv) < 0x10000 ? 3 : \
(uv) < 0x200000 ? 4 : \
(uv) < 0x4000000 ? 5 : \
(uv) < 0x80000000 ? 6 : 7 )
#endif
/*
* Note: we try to be careful never to call the isXXX_utf8() functions
* unless we're pretty sure we've seen the beginning of a UTF-8 character
* (that is, the two high bits are set). Otherwise we risk loading in the
* heavy-duty SWASHINIT and SWASHGET routines unnecessarily.
*/
#define isIDFIRST_lazy_if(p,c) ((IN_BYTES || (!c || (*((const U8*)p) < 0xc0))) \
? isIDFIRST(*(p)) \
: isIDFIRST_utf8((U8*)p))
#define isALNUM_lazy_if(p,c) ((IN_BYTES || (!c || (*((const U8*)p) < 0xc0))) \
? isALNUM(*(p)) \
: isALNUM_utf8((U8*)p))
#endif /* EBCDIC vs ASCII */
/* Rest of these are attributes of Unicode and perl's internals rather than the encoding */
#define isIDFIRST_lazy(p) isIDFIRST_lazy_if(p,1)
#define isALNUM_lazy(p) isALNUM_lazy_if(p,1)
#define UTF8_MAXBYTES 13
/* How wide can a single UTF-8 encoded character become in bytes.
* NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8
* since UTF-8 is an encoding of Unicode and given Unicode's current
* upper limit only four bytes is possible. Perl thinks of UTF-8
* as a way to encode non-negative integers in a binary format. */
#define UTF8_MAXLEN UTF8_MAXBYTES
#define UTF8_MAXLEN_UCLC 3 /* Obsolete, do not use. */
#define UTF8_MAXLEN_UCLC_MULT 39 /* Obsolete, do not use. */
#define UTF8_MAXLEN_FOLD 3 /* Obsolete, do not use. */
#define UTF8_MAXLEN_FOLD_MULT 39 /* Obsolete, do not use. */
/* The maximum number of UTF-8 bytes a single Unicode character can
* uppercase/lowercase/fold into; this number depends on the Unicode
* version. An example of maximal expansion is the U+03B0 which
* uppercases to U+03C5 U+0308 U+0301. The Unicode databases that
* tell these things are UnicodeDatabase.txt, CaseFolding.txt, and
* SpecialCasing.txt. */
#define UTF8_MAXBYTES_CASE 6
#define IN_BYTES (PL_curcop->op_private & HINT_BYTES)
#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES)
#define UTF8_ALLOW_EMPTY 0x0001
#define UTF8_ALLOW_CONTINUATION 0x0002
#define UTF8_ALLOW_NON_CONTINUATION 0x0004
#define UTF8_ALLOW_FE_FF 0x0008
#define UTF8_ALLOW_SHORT 0x0010
#define UTF8_ALLOW_SURROGATE 0x0020
#define UTF8_ALLOW_FFFF 0x0040 /* Allows also FFFE. */
#define UTF8_ALLOW_LONG 0x0080
#define UTF8_ALLOW_ANYUV (UTF8_ALLOW_EMPTY|UTF8_ALLOW_FE_FF|\
UTF8_ALLOW_SURROGATE|UTF8_ALLOW_FFFF)
#define UTF8_ALLOW_ANY 0x00FF
#define UTF8_CHECK_ONLY 0x0200
#define UNICODE_SURROGATE_FIRST 0xD800
#define UNICODE_SURROGATE_LAST 0xDFFF
#define UNICODE_REPLACEMENT 0xFFFD
#define UNICODE_BYTE_ORDER_MARK 0xFEFF
#define UNICODE_ILLEGAL 0xFFFF
/* Though our UTF-8 encoding can go beyond this,
* let's be conservative and do as Unicode 3.2 says. */
#define PERL_UNICODE_MAX 0x10FFFF
#define UNICODE_ALLOW_SURROGATE 0x0001 /* Allow UTF-16 surrogates (EVIL) */
#define UNICODE_ALLOW_FDD0 0x0002 /* Allow the U+FDD0...U+FDEF */
#define UNICODE_ALLOW_FFFF 0x0004 /* Allow 0xFFF[EF], 0x1FFF[EF], ... */
#define UNICODE_ALLOW_SUPER 0x0008 /* Allow past 10xFFFF */
#define UNICODE_ALLOW_ANY 0x000F
#define UNICODE_IS_SURROGATE(c) ((c) >= UNICODE_SURROGATE_FIRST && \
(c) <= UNICODE_SURROGATE_LAST)
#define UNICODE_IS_REPLACEMENT(c) ((c) == UNICODE_REPLACEMENT)
#define UNICODE_IS_BYTE_ORDER_MARK(c) ((c) == UNICODE_BYTE_ORDER_MARK)
#define UNICODE_IS_ILLEGAL(c) ((c) == UNICODE_ILLEGAL)
#ifdef HAS_QUAD
# define UTF8_QUAD_MAX UINT64_C(0x1000000000)
#endif
#define UTF8_IS_ASCII(c) UTF8_IS_INVARIANT(c)
#define UNICODE_LATIN_SMALL_LETTER_SHARP_S 0x00DF
#define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3
#define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2
#define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3
#define EBCDIC_LATIN_SMALL_LETTER_SHARP_S 0x0059
#define UNI_DISPLAY_ISPRINT 0x0001
#define UNI_DISPLAY_BACKSLASH 0x0002
#define UNI_DISPLAY_QQ (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
#define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
#ifdef EBCDIC
# define ANYOF_FOLD_SHARP_S(node, input, end) \
(ANYOF_BITMAP_TEST(node, EBCDIC_LATIN_SMALL_LETTER_SHARP_S) && \
(ANYOF_FLAGS(node) & ANYOF_UNICODE) && \
(ANYOF_FLAGS(node) & ANYOF_FOLD) && \
((end) > (input) + 1) && \
toLOWER((input)[0]) == 's' && \
toLOWER((input)[1]) == 's')
#else
# define ANYOF_FOLD_SHARP_S(node, input, end) \
(ANYOF_BITMAP_TEST(node, UNICODE_LATIN_SMALL_LETTER_SHARP_S) && \
(ANYOF_FLAGS(node) & ANYOF_UNICODE) && \
(ANYOF_FLAGS(node) & ANYOF_FOLD) && \
((end) > (input) + 1) && \
toLOWER((input)[0]) == 's' && \
toLOWER((input)[1]) == 's')
#endif
#define SHARP_S_SKIP 2
#ifdef EBCDIC
/* IS_UTF8_CHAR() is not ported to EBCDIC */
#else
#define IS_UTF8_CHAR_1(p) \
((p)[0] <= 0x7F)
#define IS_UTF8_CHAR_2(p) \
((p)[0] >= 0xC2 && (p)[0] <= 0xDF && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF)
#define IS_UTF8_CHAR_3a(p) \
((p)[0] == 0xE0 && \
(p)[1] >= 0xA0 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF)
#define IS_UTF8_CHAR_3b(p) \
((p)[0] >= 0xE1 && (p)[0] <= 0xEC && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF)
#define IS_UTF8_CHAR_3c(p) \
((p)[0] == 0xED && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF)
/* In IS_UTF8_CHAR_3c(p) one could use
* (p)[1] >= 0x80 && (p)[1] <= 0x9F
* if one wanted to exclude surrogates. */
#define IS_UTF8_CHAR_3d(p) \
((p)[0] >= 0xEE && (p)[0] <= 0xEF && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF)
#define IS_UTF8_CHAR_4a(p) \
((p)[0] == 0xF0 && \
(p)[1] >= 0x90 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF && \
(p)[3] >= 0x80 && (p)[3] <= 0xBF)
#define IS_UTF8_CHAR_4b(p) \
((p)[0] >= 0xF1 && (p)[0] <= 0xF3 && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF && \
(p)[3] >= 0x80 && (p)[3] <= 0xBF)
/* In IS_UTF8_CHAR_4c(p) one could use
* (p)[0] == 0xF4
* if one wanted to stop at the Unicode limit U+10FFFF.
* The 0xF7 allows us to go to 0x1fffff (0x200000 would
* require five bytes). Not doing any further code points
* since that is not needed (and that would not be strict
* UTF-8, anyway). The "slow path" in Perl_is_utf8_char()
* will take care of the "extended UTF-8". */
#define IS_UTF8_CHAR_4c(p) \
((p)[0] == 0xF4 && (p)[0] <= 0xF7 && \
(p)[1] >= 0x80 && (p)[1] <= 0xBF && \
(p)[2] >= 0x80 && (p)[2] <= 0xBF && \
(p)[3] >= 0x80 && (p)[3] <= 0xBF)
#define IS_UTF8_CHAR_3(p) \
(IS_UTF8_CHAR_3a(p) || \
IS_UTF8_CHAR_3b(p) || \
IS_UTF8_CHAR_3c(p) || \
IS_UTF8_CHAR_3d(p))
#define IS_UTF8_CHAR_4(p) \
(IS_UTF8_CHAR_4a(p) || \
IS_UTF8_CHAR_4b(p) || \
IS_UTF8_CHAR_4c(p))
/* IS_UTF8_CHAR(p) is strictly speaking wrong (not UTF-8) because it
* (1) allows UTF-8 encoded UTF-16 surrogates
* (2) it allows code points past U+10FFFF.
* The Perl_is_utf8_char() full "slow" code will handle the Perl
* "extended UTF-8". */
#define IS_UTF8_CHAR(p, n) \
((n) == 1 ? IS_UTF8_CHAR_1(p) : \
(n) == 2 ? IS_UTF8_CHAR_2(p) : \
(n) == 3 ? IS_UTF8_CHAR_3(p) : \
(n) == 4 ? IS_UTF8_CHAR_4(p) : 0)
#define IS_UTF8_CHAR_FAST(n) ((n) <= 4)
#endif /* IS_UTF8_CHAR() for UTF-8 */
--- NEW FILE: proto.h ---
/* -*- buffer-read-only: t -*-
*
* proto.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by embed.pl from data in embed.fnc, embed.pl,
* pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
* Any changes made here will be lost!
*
* Edit those files and run 'make regen_headers' to effect changes.
*/
START_EXTERN_C
[...2277 lines suppressed...]
PERL_CALLCONV void Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size);
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
PERL_CALLCONV void Perl_dump_sv_child(pTHX_ SV *sv);
#endif
#ifdef PERL_DONT_CREATE_GVSV
PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV* gv);
#endif
PERL_CALLCONV bool Perl_ckwarn(pTHX_ U32 w);
PERL_CALLCONV bool Perl_ckwarn_d(pTHX_ U32 w);
PERL_CALLCONV void Perl_my_clearenv(pTHX);
END_EXTERN_C
/*
* ex: set ts=8 sts=4 sw=4 noet:
*/
/* ex: set ro: */
--- NEW FILE: keywords.h ---
/* -*- buffer-read-only: t -*-
*
* keywords.h
*
* Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2005,
* 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by keywords.pl from its data. Any changes made here
* will be lost!
*/
#define KEY_NULL 0
#define KEY___FILE__ 1
#define KEY___LINE__ 2
#define KEY___PACKAGE__ 3
#define KEY___DATA__ 4
#define KEY___END__ 5
#define KEY_AUTOLOAD 6
#define KEY_BEGIN 7
#define KEY_CORE 8
#define KEY_DESTROY 9
#define KEY_END 10
#define KEY_INIT 11
#define KEY_CHECK 12
#define KEY_abs 13
#define KEY_accept 14
#define KEY_alarm 15
#define KEY_and 16
#define KEY_atan2 17
#define KEY_bind 18
#define KEY_binmode 19
#define KEY_bless 20
#define KEY_caller 21
#define KEY_chdir 22
#define KEY_chmod 23
#define KEY_chomp 24
#define KEY_chop 25
#define KEY_chown 26
#define KEY_chr 27
#define KEY_chroot 28
#define KEY_close 29
#define KEY_closedir 30
#define KEY_cmp 31
#define KEY_connect 32
#define KEY_continue 33
#define KEY_cos 34
#define KEY_crypt 35
#define KEY_dbmclose 36
#define KEY_dbmopen 37
#define KEY_defined 38
#define KEY_delete 39
#define KEY_die 40
#define KEY_do 41
#define KEY_dump 42
#define KEY_each 43
#define KEY_else 44
#define KEY_elsif 45
#define KEY_endgrent 46
#define KEY_endhostent 47
#define KEY_endnetent 48
#define KEY_endprotoent 49
#define KEY_endpwent 50
#define KEY_endservent 51
#define KEY_eof 52
#define KEY_eq 53
#define KEY_eval 54
#define KEY_exec 55
#define KEY_exists 56
#define KEY_exit 57
#define KEY_exp 58
#define KEY_fcntl 59
#define KEY_fileno 60
#define KEY_flock 61
#define KEY_for 62
#define KEY_foreach 63
#define KEY_fork 64
#define KEY_format 65
#define KEY_formline 66
#define KEY_ge 67
#define KEY_getc 68
#define KEY_getgrent 69
#define KEY_getgrgid 70
#define KEY_getgrnam 71
#define KEY_gethostbyaddr 72
#define KEY_gethostbyname 73
#define KEY_gethostent 74
#define KEY_getlogin 75
#define KEY_getnetbyaddr 76
#define KEY_getnetbyname 77
#define KEY_getnetent 78
#define KEY_getpeername 79
#define KEY_getpgrp 80
#define KEY_getppid 81
#define KEY_getpriority 82
#define KEY_getprotobyname 83
#define KEY_getprotobynumber 84
#define KEY_getprotoent 85
#define KEY_getpwent 86
#define KEY_getpwnam 87
#define KEY_getpwuid 88
#define KEY_getservbyname 89
#define KEY_getservbyport 90
#define KEY_getservent 91
#define KEY_getsockname 92
#define KEY_getsockopt 93
#define KEY_glob 94
#define KEY_gmtime 95
#define KEY_goto 96
#define KEY_grep 97
#define KEY_gt 98
#define KEY_hex 99
#define KEY_if 100
#define KEY_index 101
#define KEY_int 102
#define KEY_ioctl 103
#define KEY_join 104
#define KEY_keys 105
#define KEY_kill 106
#define KEY_last 107
#define KEY_lc 108
#define KEY_lcfirst 109
#define KEY_le 110
#define KEY_length 111
#define KEY_link 112
#define KEY_listen 113
#define KEY_local 114
#define KEY_localtime 115
#define KEY_lock 116
#define KEY_log 117
#define KEY_lstat 118
#define KEY_lt 119
#define KEY_m 120
#define KEY_map 121
#define KEY_mkdir 122
#define KEY_msgctl 123
#define KEY_msgget 124
#define KEY_msgrcv 125
#define KEY_msgsnd 126
#define KEY_my 127
#define KEY_ne 128
#define KEY_next 129
#define KEY_no 130
#define KEY_not 131
#define KEY_oct 132
#define KEY_open 133
#define KEY_opendir 134
#define KEY_or 135
#define KEY_ord 136
#define KEY_our 137
#define KEY_pack 138
#define KEY_package 139
#define KEY_pipe 140
#define KEY_pop 141
#define KEY_pos 142
#define KEY_print 143
#define KEY_printf 144
#define KEY_prototype 145
#define KEY_push 146
#define KEY_q 147
#define KEY_qq 148
#define KEY_qr 149
#define KEY_quotemeta 150
#define KEY_qw 151
#define KEY_qx 152
#define KEY_rand 153
#define KEY_read 154
#define KEY_readdir 155
#define KEY_readline 156
#define KEY_readlink 157
#define KEY_readpipe 158
#define KEY_recv 159
#define KEY_redo 160
#define KEY_ref 161
#define KEY_rename 162
#define KEY_require 163
#define KEY_reset 164
#define KEY_return 165
#define KEY_reverse 166
#define KEY_rewinddir 167
#define KEY_rindex 168
#define KEY_rmdir 169
#define KEY_s 170
#define KEY_scalar 171
#define KEY_seek 172
#define KEY_seekdir 173
#define KEY_select 174
#define KEY_semctl 175
#define KEY_semget 176
#define KEY_semop 177
#define KEY_send 178
#define KEY_setgrent 179
#define KEY_sethostent 180
#define KEY_setnetent 181
#define KEY_setpgrp 182
#define KEY_setpriority 183
#define KEY_setprotoent 184
#define KEY_setpwent 185
#define KEY_setservent 186
#define KEY_setsockopt 187
#define KEY_shift 188
#define KEY_shmctl 189
#define KEY_shmget 190
#define KEY_shmread 191
#define KEY_shmwrite 192
#define KEY_shutdown 193
#define KEY_sin 194
#define KEY_sleep 195
#define KEY_socket 196
#define KEY_socketpair 197
#define KEY_sort 198
#define KEY_splice 199
#define KEY_split 200
#define KEY_sprintf 201
#define KEY_sqrt 202
#define KEY_srand 203
#define KEY_stat 204
#define KEY_study 205
#define KEY_sub 206
#define KEY_substr 207
#define KEY_symlink 208
#define KEY_syscall 209
#define KEY_sysopen 210
#define KEY_sysread 211
#define KEY_sysseek 212
#define KEY_system 213
#define KEY_syswrite 214
#define KEY_tell 215
#define KEY_telldir 216
#define KEY_tie 217
#define KEY_tied 218
#define KEY_time 219
#define KEY_times 220
#define KEY_tr 221
#define KEY_truncate 222
#define KEY_uc 223
#define KEY_ucfirst 224
#define KEY_umask 225
#define KEY_undef 226
#define KEY_unless 227
#define KEY_unlink 228
#define KEY_unpack 229
#define KEY_unshift 230
#define KEY_untie 231
#define KEY_until 232
#define KEY_use 233
#define KEY_utime 234
#define KEY_values 235
#define KEY_vec 236
#define KEY_wait 237
#define KEY_waitpid 238
#define KEY_wantarray 239
#define KEY_warn 240
#define KEY_while 241
#define KEY_write 242
#define KEY_x 243
#define KEY_xor 244
#define KEY_y 245
/* ex: set ro: */
--- NEW FILE: Changes5.6 ---
Please note: This file provides a complete, temporally ordered log of
changes that went into every version of Perl. If you'd like more
detailed information, please consult the comments in the individual
patches posted to the perl5-porters mailing list. Patches for each
individual change may also be obtained through ftp and rsync--see
perlhack.pod for the details.
---------------
CAST AND CREW
---------------
To give due honor to those who have made Perl what is is today,
here are some of the more common names in the Changes file, and their
current addresses (as of February 2000):
Gisle Aas <gisle at aas.no>
Abigail <abigail at delanet.com>
Kenneth Albanowski <kjahds at kjahds.com>
[...27391 lines suppressed...]
! op.c op.h perl.h perlvars.h pod/perlfunc.pod pod/perlop.pod
! pod/perlre.pod pp.c pp_ctl.c pp_hot.c proto.h regcomp.c
! regcomp.h regcomp.sym regexec.c regexp.h regnodes.h sv.c
! t/op/vec.t toke.c util.c vms/vmsish.h
____________________________________________________________________________
[ 1650] By: gsar on 1998/07/24 04:06:48
Log: create utfperl branch
Branch: utfperl
+> (branch 1079 files)
____________________________________________________________________________
[ 1649] By: gsar on 1998/07/24 03:56:56
Log: create maint-5.005 branch
Branch: maint-5.005/perl
+> (branch 1079 files)
____________________________________________________________________________
[ 1648] By: gsar on 1998/07/24 03:36:35
Log: un-checked-in 5.005 Changes (this is 5.005 *exactly*)
Branch: perl
! Changes
--- NEW FILE: EXTERN.h ---
/* EXTERN.h
*
* Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* EXT designates a global var which is defined in perl.h
* dEXT designates a global var which is defined in another
* file, so we can't count on finding it in perl.h
* (this practice should be avoided).
*/
#undef EXT
#undef dEXT
#undef EXTCONST
#undef dEXTCONST
#if defined(VMS) && !defined(__GNUC__)
/* Suppress portability warnings from DECC for VMS-specific extensions */
# ifdef __DECC
# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
# endif
# define EXT globalref
# define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
# define EXTCONST globalref
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
# if defined(WIN32) && !defined(PERL_STATIC_SYMS)
# ifdef PERLDLL
# define EXT extern __declspec(dllexport)
# define dEXT
# define EXTCONST extern __declspec(dllexport) const
# define dEXTCONST const
# else
# define EXT extern __declspec(dllimport)
# define dEXT
# define EXTCONST extern __declspec(dllimport) const
# define dEXTCONST const
# endif
# else
# if defined(__CYGWIN__) && defined(USEIMPORTLIB)
# define EXT extern __declspec(dllimport)
# define dEXT
# define EXTCONST extern __declspec(dllimport) const
# define dEXTCONST const
# else
# define EXT extern
# define dEXT
# define EXTCONST extern const
# define dEXTCONST const
# endif
# endif
#endif
#undef INIT
#define INIT(x)
#undef DOINIT
--- NEW FILE: utf8.c ---
/* utf8.c
*
* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006,
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* 'What a fix!' said Sam. 'That's the one place in all the lands we've ever
* heard of that we don't want to see any closer; and that's the one place
* we're trying to get to! And that's just where we can't get, nohow.'
*
* 'Well do I understand your speech,' he answered in the same language;
* 'yet few strangers do so. Why then do you not speak in the Common Tongue,
* as is the custom in the West, if you wish to be answered?'
*
[...2060 lines suppressed...]
if (match) {
if (pe1)
*pe1 = (char*)p1;
if (pe2)
*pe2 = (char*)p2;
}
return match ? 0 : 1; /* 0 match, 1 mismatch */
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: embed.pl ---
#!/usr/bin/perl -w
require 5.003; # keep this compatible, an old perl is all we may have before
# we build the new one
BEGIN {
# Get function prototypes
require 'regen_lib.pl';
}
#
# See database of global and static function prototypes in embed.fnc
# This is used to generate prototype headers under various configurations,
# export symbols lists for different platforms, and macros to provide an
# implicit interpreter context argument.
#
sub do_not_edit ($)
{
my $file = shift;
my $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006';
$years =~ s/1999,/1999,\n / if length $years > 40;
my $warning = <<EOW;
-*- buffer-read-only: t -*-
$file
Copyright (C) $years, by Larry Wall and others
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the README file.
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by embed.pl from data in embed.fnc, embed.pl,
pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
Any changes made here will be lost!
Edit those files and run 'make regen_headers' to effect changes.
EOW
$warning .= <<EOW if $file eq 'perlapi.c';
Up to the threshold of the door there mounted a flight of twenty-seven
broad stairs, hewn by some unknown art of the same black stone. This
was the only entrance to the tower.
EOW
if ($file =~ m:\.[ch]$:) {
$warning =~ s:^: * :gm;
$warning =~ s: +$::gm;
$warning =~ s: :/:;
$warning =~ s:$:/:;
}
else {
$warning =~ s:^:# :gm;
$warning =~ s: +$::gm;
}
$warning;
} # do_not_edit
open IN, "embed.fnc" or die $!;
# walk table providing an array of components in each line to
# subroutine, printing the result
sub walk_table (&@) {
my $function = shift;
my $filename = shift || '-';
my $leader = shift;
defined $leader or $leader = do_not_edit ($filename);
my $trailer = shift;
my $F;
local *F;
if (ref $filename) { # filehandle
$F = $filename;
}
else {
safer_unlink $filename if $filename ne '/dev/null';
open F, ">$filename" or die "Can't open $filename: $!";
binmode F;
$F = \*F;
}
print $F $leader if $leader;
seek IN, 0, 0; # so we may restart
while (<IN>) {
chomp;
next if /^:/;
while (s|\\$||) {
$_ .= <IN>;
chomp;
}
s/\s+$//;
my @args;
if (/^\s*(#|$)/) {
@args = $_;
}
else {
@args = split /\s*\|\s*/, $_;
}
my @outs = &{$function}(@args);
print $F @outs; # $function->(@args) is not 5.003
}
print $F $trailer if $trailer;
unless (ref $filename) {
close $F or die "Error closing $filename: $!";
}
}
sub munge_c_files () {
my $functions = {};
unless (@ARGV) {
warn "\@ARGV empty, nothing to do\n";
return;
}
walk_table {
if (@_ > 1) {
$functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
}
} '/dev/null', '', '';
local $^I = '.bak';
while (<>) {
# if (/^#\s*include\s+"perl.h"/) {
# my $file = uc $ARGV;
# $file =~ s/\./_/g;
# print "#define PERL_IN_$file\n";
# }
# s{^(\w+)\s*\(}
# {
# my $f = $1;
# my $repl = "$f(";
# if (exists $functions->{$f}) {
# my $flags = $functions->{$f}[0];
# $repl = "Perl_$repl" if $flags =~ /p/;
# unless ($flags =~ /n/) {
# $repl .= "pTHX";
# $repl .= "_ " if @{$functions->{$f}} > 3;
# }
# warn("$ARGV:$.:$repl\n");
# }
# $repl;
# }e;
s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
{
my $repl = $1;
my $f = $2;
if (exists $functions->{$f}) {
$repl .= "aTHX_ ";
warn("$ARGV:$.:$`#$repl#$'");
}
$repl;
}eg;
print;
close ARGV if eof; # restart $.
}
exit;
}
#munge_c_files();
# generate proto.h
my $wrote_protected = 0;
sub write_protos {
my $ret = "";
if (@_ == 1) {
my $arg = shift;
$ret .= "$arg\n";
}
else {
my ($flags,$retval,$func, at args) = @_;
my @nonnull;
my $has_context = ( $flags !~ /n/ );
$ret .= '/* ' if $flags =~ /m/;
if ($flags =~ /s/) {
$retval = "STATIC $retval";
$func = "S_$func";
}
else {
$retval = "PERL_CALLCONV $retval";
if ($flags =~ /p/) {
$func = "Perl_$func";
}
}
$ret .= "$retval\t$func(";
if ( $has_context ) {
$ret .= @args ? "pTHX_ " : "pTHX";
}
if (@args) {
my $n;
for my $arg ( @args ) {
++$n;
if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) {
warn "$func: $arg needs NN or NULLOK\n";
our $unflagged_pointers;
++$unflagged_pointers;
}
# Given the bugs fixed by changes 25822 and 26253, for now
# strip NN with no effect, until I'm confident that there are
# no similar bugs lurking.
# push( @nonnull, $n ) if ( $arg =~ s/\s*\bNN\b\s+// );
$arg =~ s/\s*\bNN\b\s+//;
$arg =~ s/\s*\bNULLOK\b\s+//; # strip NULLOK with no effect
}
$ret .= join ", ", @args;
}
else {
$ret .= "void" if !$has_context;
}
$ret .= ")";
my @attrs;
if ( $flags =~ /r/ ) {
push @attrs, "__attribute__noreturn__";
}
if ( $flags =~ /a/ ) {
push @attrs, "__attribute__malloc__";
$flags .= "R"; # All allocing must check return value
}
if ( $flags =~ /R/ ) {
push @attrs, "__attribute__warn_unused_result__";
}
if ( $flags =~ /P/ ) {
push @attrs, "__attribute__pure__";
}
if( $flags =~ /f/ ) {
my $prefix = $has_context ? 'pTHX_' : '';
my $args = scalar @args;
push @attrs, sprintf "__attribute__format__(__printf__,%s%d,%s%d)",
$prefix, $args - 1, $prefix, $args;
}
if ( @nonnull ) {
my @pos = map { $has_context ? "pTHX_$_" : $_ } @nonnull;
push @attrs, map { sprintf( "__attribute__nonnull__(%s)", $_ ) } @pos;
}
if ( @attrs ) {
$ret .= "\n";
$ret .= join( "\n", map { "\t\t\t$_" } @attrs );
}
$ret .= ";";
$ret .= ' */' if $flags =~ /m/;
$ret .= @attrs ? "\n\n" : "\n";
}
$ret;
}
# generates global.sym (API export list), and populates %global with global symbols
sub write_global_sym {
my $ret = "";
if (@_ > 1) {
my ($flags,$retval,$func, at args) = @_;
if ($flags =~ /[AX]/ && $flags !~ /[xm]/
|| $flags =~ /b/) { # public API, so export
$func = "Perl_$func" if $flags =~ /[pbX]/;
$ret = "$func\n";
}
}
$ret;
}
our $unflagged_pointers;
walk_table(\&write_protos, "proto.h", undef, "/* ex: set ro: */\n");
warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
walk_table(\&write_global_sym, "global.sym", undef, "# ex: set ro:\n");
# XXX others that may need adding
# warnhook
# hints
# copline
my @extvars = qw(sv_undef sv_yes sv_no na dowarn
curcop compiling
tainting tainted stack_base stack_sp sv_arenaroot
no_modify
curstash DBsub DBsingle debstash
rsfp
stdingv
defgv
errgv
rsfp_filters
perldb
diehook
dirty
perl_destruct_level
ppaddr
);
sub readsyms (\%$) {
my ($syms, $file) = @_;
local (*FILE, $_);
open(FILE, "< $file")
or die "embed.pl: Can't open $file: $!\n";
while (<FILE>) {
s/[ \t]*#.*//; # Delete comments.
if (/^\s*(\S+)\s*$/) {
my $sym = $1;
warn "duplicate symbol $sym while processing $file\n"
if exists $$syms{$sym};
$$syms{$sym} = 1;
}
}
close(FILE);
}
# Perl_pp_* and Perl_ck_* are in pp.sym
readsyms my %ppsym, 'pp.sym';
sub readvars(\%$$@) {
my ($syms, $file,$pre,$keep_pre) = @_;
local (*FILE, $_);
open(FILE, "< $file")
or die "embed.pl: Can't open $file: $!\n";
while (<FILE>) {
s/[ \t]*#.*//; # Delete comments.
if (/PERLVARA?I?C?\($pre(\w+)/) {
my $sym = $1;
$sym = $pre . $sym if $keep_pre;
warn "duplicate symbol $sym while processing $file\n"
if exists $$syms{$sym};
$$syms{$sym} = $pre || 1;
}
}
close(FILE);
}
my %intrp;
my %thread;
readvars %intrp, 'intrpvar.h','I';
readvars %thread, 'thrdvar.h','T';
readvars %globvar, 'perlvars.h','G';
my $sym;
foreach $sym (sort keys %thread) {
warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
}
sub undefine ($) {
my ($sym) = @_;
"#undef $sym\n";
}
sub hide ($$) {
my ($from, $to) = @_;
my $t = int(length($from) / 8);
"#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
}
sub bincompat_var ($$) {
my ($pfx, $sym) = @_;
my $arg = ($pfx eq 'G' ? 'NULL' : 'aTHX');
undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr($arg))");
}
sub multon ($$$) {
my ($sym,$pre,$ptr) = @_;
hide("PL_$sym", "($ptr$pre$sym)");
}
sub multoff ($$) {
my ($sym,$pre) = @_;
return hide("PL_$pre$sym", "PL_$sym");
}
safer_unlink 'embed.h';
open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
binmode EM;
print EM do_not_edit ("embed.h"), <<'END';
/* (Doing namespace management portably in C is really gross.) */
/* By defining PERL_NO_SHORT_NAMES (not done by default) the short forms
* (like warn instead of Perl_warn) for the API are not defined.
* Not defining the short forms is a good thing for cleaner embedding. */
#ifndef PERL_NO_SHORT_NAMES
/* Hide global symbols */
#if !defined(PERL_IMPLICIT_CONTEXT)
END
# Try to elimiate lots of repeated
# #ifdef PERL_CORE
# foo
# #endif
# #ifdef PERL_CORE
# bar
# #endif
# by tracking state and merging foo and bar into one block.
my $ifdef_state = '';
walk_table {
my $ret = "";
my $new_ifdef_state = '';
if (@_ == 1) {
my $arg = shift;
$ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
}
else {
my ($flags,$retval,$func, at args) = @_;
unless ($flags =~ /[om]/) {
if ($flags =~ /s/) {
$ret .= hide($func,"S_$func");
}
elsif ($flags =~ /p/) {
$ret .= hide($func,"Perl_$func");
}
}
if ($ret ne '' && $flags !~ /A/) {
if ($flags =~ /E/) {
$new_ifdef_state
= "#if defined(PERL_CORE) || defined(PERL_EXT)\n";
}
else {
$new_ifdef_state = "#ifdef PERL_CORE\n";
}
if ($new_ifdef_state ne $ifdef_state) {
$ret = $new_ifdef_state . $ret;
}
}
}
if ($ifdef_state && $new_ifdef_state ne $ifdef_state) {
# Close the old one ahead of opening the new one.
$ret = "#endif\n$ret";
}
# Remember the new state.
$ifdef_state = $new_ifdef_state;
$ret;
} \*EM, "";
if ($ifdef_state) {
print EM "#endif\n";
}
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
print EM hide($sym, "Perl_$sym");
}
print EM <<'END';
#else /* PERL_IMPLICIT_CONTEXT */
END
my @az = ('a'..'z');
$ifdef_state = '';
walk_table {
my $ret = "";
my $new_ifdef_state = '';
if (@_ == 1) {
my $arg = shift;
$ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/;
}
else {
my ($flags,$retval,$func, at args) = @_;
unless ($flags =~ /[om]/) {
my $args = scalar @args;
if ($args and $args[$args-1] =~ /\.\.\./) {
# we're out of luck for varargs functions under CPP
}
elsif ($flags =~ /n/) {
if ($flags =~ /s/) {
$ret .= hide($func,"S_$func");
}
elsif ($flags =~ /p/) {
$ret .= hide($func,"Perl_$func");
}
}
else {
my $alist = join(",", @az[0..$args-1]);
$ret = "#define $func($alist)";
my $t = int(length($ret) / 8);
$ret .= "\t" x ($t < 4 ? 4 - $t : 1);
if ($flags =~ /s/) {
$ret .= "S_$func(aTHX";
}
elsif ($flags =~ /p/) {
$ret .= "Perl_$func(aTHX";
}
$ret .= "_ " if $alist;
$ret .= $alist . ")\n";
}
}
unless ($flags =~ /A/) {
if ($flags =~ /E/) {
$new_ifdef_state
= "#if defined(PERL_CORE) || defined(PERL_EXT)\n";
}
else {
$new_ifdef_state = "#ifdef PERL_CORE\n";
}
if ($new_ifdef_state ne $ifdef_state) {
$ret = $new_ifdef_state . $ret;
}
}
}
if ($ifdef_state && $new_ifdef_state ne $ifdef_state) {
# Close the old one ahead of opening the new one.
$ret = "#endif\n$ret";
}
# Remember the new state.
$ifdef_state = $new_ifdef_state;
$ret;
} \*EM, "";
if ($ifdef_state) {
print EM "#endif\n";
}
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
if ($sym =~ /^ck_/) {
print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
}
elsif ($sym =~ /^pp_/) {
print EM hide("$sym()", "Perl_$sym(aTHX)");
}
else {
warn "Illegal symbol '$sym' in pp.sym";
}
}
print EM <<'END';
#endif /* PERL_IMPLICIT_CONTEXT */
#endif /* #ifndef PERL_NO_SHORT_NAMES */
END
print EM <<'END';
/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
disable them.
*/
#if !defined(PERL_CORE)
# define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,PTR2IV(ptr))
# define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,PTR2IV(ptr))
#endif
#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
/* Compatibility for various misnamed functions. All functions
in the API that begin with "perl_" (not "Perl_") take an explicit
interpreter context pointer.
The following are not like that, but since they had a "perl_"
prefix in previous versions, we provide compatibility macros.
*/
# define perl_atexit(a,b) call_atexit(a,b)
# define perl_call_argv(a,b,c) call_argv(a,b,c)
# define perl_call_pv(a,b) call_pv(a,b)
# define perl_call_method(a,b) call_method(a,b)
# define perl_call_sv(a,b) call_sv(a,b)
# define perl_eval_sv(a,b) eval_sv(a,b)
# define perl_eval_pv(a,b) eval_pv(a,b)
# define perl_require_pv(a) require_pv(a)
# define perl_get_sv(a,b) get_sv(a,b)
# define perl_get_av(a,b) get_av(a,b)
# define perl_get_hv(a,b) get_hv(a,b)
# define perl_get_cv(a,b) get_cv(a,b)
# define perl_init_i18nl10n(a) init_i18nl10n(a)
# define perl_init_i18nl14n(a) init_i18nl14n(a)
# define perl_new_ctype(a) new_ctype(a)
# define perl_new_collate(a) new_collate(a)
# define perl_new_numeric(a) new_numeric(a)
/* varargs functions can't be handled with CPP macros. :-(
This provides a set of compatibility functions that don't take
an extra argument but grab the context pointer using the macro
dTHX.
*/
#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_NO_SHORT_NAMES)
# define croak Perl_croak_nocontext
# define deb Perl_deb_nocontext
# define die Perl_die_nocontext
# define form Perl_form_nocontext
# define load_module Perl_load_module_nocontext
# define mess Perl_mess_nocontext
# define newSVpvf Perl_newSVpvf_nocontext
# define sv_catpvf Perl_sv_catpvf_nocontext
# define sv_setpvf Perl_sv_setpvf_nocontext
# define warn Perl_warn_nocontext
# define warner Perl_warner_nocontext
# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
#endif
#endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
#if !defined(PERL_IMPLICIT_CONTEXT)
/* undefined symbols, point them back at the usual ones */
# define Perl_croak_nocontext Perl_croak
# define Perl_die_nocontext Perl_die
# define Perl_deb_nocontext Perl_deb
# define Perl_form_nocontext Perl_form
# define Perl_load_module_nocontext Perl_load_module
# define Perl_mess_nocontext Perl_mess
# define Perl_newSVpvf_nocontext Perl_newSVpvf
# define Perl_sv_catpvf_nocontext Perl_sv_catpvf
# define Perl_sv_setpvf_nocontext Perl_sv_setpvf
# define Perl_warn_nocontext Perl_warn
# define Perl_warner_nocontext Perl_warner
# define Perl_sv_catpvf_mg_nocontext Perl_sv_catpvf_mg
# define Perl_sv_setpvf_mg_nocontext Perl_sv_setpvf_mg
#endif
/* ex: set ro: */
END
close(EM) or die "Error closing EM: $!";
safer_unlink 'embedvar.h';
open(EM, '> embedvar.h')
or die "Can't create embedvar.h: $!\n";
binmode EM;
print EM do_not_edit ("embedvar.h"), <<'END';
/* (Doing namespace management portably in C is really gross.) */
/*
The following combinations of MULTIPLICITY, USE_5005THREADS
and PERL_IMPLICIT_CONTEXT are supported:
1) none
2) MULTIPLICITY # supported for compatibility
3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
All other combinations of these flags are errors.
#3, #4, #5, and #6 are supported directly, while #2 is a special
case of #3 (supported by redefining vTHX appropriately).
*/
#if defined(MULTIPLICITY)
/* cases 2, 3 and 5 above */
# if defined(PERL_IMPLICIT_CONTEXT)
# define vTHX aTHX
# else
# define vTHX PERL_GET_INTERP
# endif
END
for $sym (sort keys %thread) {
print EM multon($sym,'T','vTHX->');
}
print EM <<'END';
# if defined(USE_5005THREADS)
/* case 5 above */
END
for $sym (sort keys %intrp) {
print EM multon($sym,'I','PERL_GET_INTERP->');
}
print EM <<'END';
# else /* !USE_5005THREADS */
/* cases 2 and 3 above */
END
for $sym (sort keys %intrp) {
print EM multon($sym,'I','vTHX->');
}
print EM <<'END';
# endif /* USE_5005THREADS */
#else /* !MULTIPLICITY */
/* cases 1 and 4 above */
END
for $sym (sort keys %intrp) {
print EM multoff($sym,'I');
}
print EM <<'END';
# if defined(USE_5005THREADS)
/* case 4 above */
END
for $sym (sort keys %thread) {
print EM multon($sym,'T','aTHX->');
}
print EM <<'END';
# else /* !USE_5005THREADS */
/* case 1 above */
END
for $sym (sort keys %thread) {
print EM multoff($sym,'T');
}
print EM <<'END';
# endif /* USE_5005THREADS */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
END
for $sym (sort keys %globvar) {
print EM multon($sym,'G','PL_Vars.');
}
print EM <<'END';
#else /* !PERL_GLOBAL_STRUCT */
END
for $sym (sort keys %globvar) {
print EM multoff($sym,'G');
}
print EM <<'END';
#endif /* PERL_GLOBAL_STRUCT */
#ifdef PERL_POLLUTE /* disabled by default in 5.6.0 */
END
for $sym (sort @extvars) {
print EM hide($sym,"PL_$sym");
}
print EM <<'END';
#endif /* PERL_POLLUTE */
/* ex: set ro: */
END
close(EM) or die "Error closing EM: $!";
safer_unlink 'perlapi.h';
safer_unlink 'perlapi.c';
open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
binmode CAPI;
open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
binmode CAPIH;
print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
/* declare accessor functions for Perl variables */
#ifndef __perlapi_h__
#define __perlapi_h__
#if defined (MULTIPLICITY)
START_EXTERN_C
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
#include "thrdvar.h"
#include "intrpvar.h"
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
END_EXTERN_C
#if defined(PERL_CORE)
/* accessor functions for Perl variables (provide binary compatibility) */
/* these need to be mentioned here, or most linkers won't put them in
the perl executable */
#ifndef PERL_NO_FORCE_LINK
START_EXTERN_C
#ifndef DOINIT
EXT void *PL_force_link_funcs[];
#else
EXT void *PL_force_link_funcs[] = {
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) (void*)Perl_##v##_ptr,
#define PERLVARA(v,n,t) PERLVAR(v,t)
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v,t)
/* In Tru64 (__DEC && __osf__) the cc option -std1 causes that one
* cannot cast between void pointers and function pointers without
* info level warnings. The PL_force_link_funcs[] would cause a few
* hundred of those warnings. In code one can circumnavigate this by using
* unions that overlay the different pointers, but in declarations one
* cannot use this trick. Therefore we just disable the warning here
* for the duration of the PL_force_link_funcs[] declaration. */
#if defined(__DECC) && defined(__osf__)
#pragma message save
#pragma message disable (nonstandcast)
#endif
#include "thrdvar.h"
#include "intrpvar.h"
#include "perlvars.h"
#if defined(__DECC) && defined(__osf__)
#pragma message restore
#endif
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
};
#endif /* DOINIT */
END_EXTERN_C
#endif /* PERL_NO_FORCE_LINK */
#else /* !PERL_CORE */
EOT
foreach $sym (sort keys %intrp) {
print CAPIH bincompat_var('I',$sym);
}
foreach $sym (sort keys %thread) {
print CAPIH bincompat_var('T',$sym);
}
foreach $sym (sort keys %globvar) {
print CAPIH bincompat_var('G',$sym);
}
print CAPIH <<'EOT';
#endif /* !PERL_CORE */
#endif /* MULTIPLICITY */
#endif /* __perlapi_h__ */
/* ex: set ro: */
EOT
close CAPIH or die "Error closing CAPIH: $!";
print CAPI do_not_edit ("perlapi.c"), <<'EOT';
#include "EXTERN.h"
#include "perl.h"
#include "perlapi.h"
#if defined (MULTIPLICITY)
/* accessor functions for Perl variables (provides binary compatibility) */
START_EXTERN_C
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
{ return &(aTHX->v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
{ return &(aTHX->v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
#include "thrdvar.h"
#include "intrpvar.h"
#undef PERLVAR
#undef PERLVARA
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
{ return &(PL_##v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
{ return &(PL_##v); }
#undef PERLVARIC
#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
{ return (const t *)&(PL_##v); }
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
END_EXTERN_C
#endif /* MULTIPLICITY */
/* ex: set ro: */
EOT
close(CAPI) or die "Error closing CAPI: $!";
# functions that take va_list* for implementing vararg functions
# NOTE: makedef.pl must be updated if you add symbols to %vfuncs
# XXX %vfuncs currently unused
my %vfuncs = qw(
Perl_croak Perl_vcroak
Perl_warn Perl_vwarn
Perl_warner Perl_vwarner
Perl_die Perl_vdie
Perl_form Perl_vform
Perl_load_module Perl_vload_module
Perl_mess Perl_vmess
Perl_deb Perl_vdeb
Perl_newSVpvf Perl_vnewSVpvf
Perl_sv_setpvf Perl_sv_vsetpvf
Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
Perl_sv_catpvf Perl_sv_vcatpvf
Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
Perl_dump_indent Perl_dump_vindent
Perl_default_protect Perl_vdefault_protect
);
# ex: set ts=8 sts=4 sw=4 noet:
--- NEW FILE: README.hpux ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.hpux - Perl version 5 on Hewlett-Packard Unix (HP-UX) systems
=head1 DESCRIPTION
This document describes various features of HP's Unix operating system
(HP-UX) that will affect how Perl version 5 (hereafter just Perl) is
compiled and/or runs.
=head2 Using perl as shipped with HP-UX
Application release September 2001, HP-UX 11.00 is the first to ship
with Perl. By the time it was perl-5.6.1 in /opt/perl. The first
occurrence is on CD 5012-7954 and can be installed using
swinstall -s /cdrom perl
assuming you have mounted that CD on /cdrom. In this version the
following modules were installed:
ActivePerl::DocTools-0.04 HTML::Parser-3.19 XML::DOM-1.25
Archive::Tar-0.072 HTML::Tagset-3.03 XML::Parser-2.27
Compress::Zlib-1.08 MIME::Base64-2.11 XML::Simple-1.05
Convert::ASN1-0.10 Net-1.07 XML::XPath-1.09
Digest::MD5-2.11 PPM-2.1.5 XML::XSLT-0.32
File::CounterFile-0.12 SOAP::Lite-0.46 libwww-perl-5.51
Font::AFM-1.18 Storable-1.011 libxml-perl-0.07
HTML-Tree-3.11 URI-1.11 perl-ldap-0.23
The build was a portable hppa-1.1 multithread build that supports large
files compiled with gcc-2.9-hppa-991112
If you perform a new installation, then Perl will be installed
automatically.
More recent (preinstalled) HP-UX systems have more recent versions of
Perl and the updated modules.
=head2 Using perl from HP's porting centre
HP porting centre tries very hard to keep up with customer demand and
release updates from the Open Source community. Having precompiled
Perl binaries available is obvious.
The HP porting centres are limited in what systems they are allowed
to port to and they usually choose the two most recent OS versions
available. This means that at the moment of writing, there are only
HP-UX 11.11 (pa-risc 2.0) and HP-UX 11.23 (Itanium 2) ports available
on the porting centres.
HP has asked the porting centre to move Open Source binaries
from /opt to /usr/local, so binaries produced since the start
of July 2002 are located in /usr/local.
One of HP porting centres URL's is http://hpux.connect.org.uk/
The port currently available is built with GNU gcc.
=head2 Compiling Perl 5 on HP-UX
When compiling Perl, you must use an ANSI C compiler. The C compiler
that ships with all HP-UX systems is a K&R compiler that should only be
used to build new kernels.
Perl can be compiled with either HP's ANSI C compiler or with gcc. The
former is recommended, as not only can it compile Perl with no
difficulty, but also can take advantage of features listed later that
require the use of HP compiler-specific command-line flags.
If you decide to use gcc, make sure your installation is recent and
complete, and be sure to read the Perl INSTALL file for more gcc-specific
details.
=head2 PA-RISC
HP's current Unix systems run on its own Precision Architecture
(PA-RISC) chip. HP-UX used to run on the Motorola MC68000 family of
chips, but any machine with this chip in it is quite obsolete and this
document will not attempt to address issues for compiling Perl on the
Motorola chipset.
The most recent version of PA-RISC at the time of this document's last
update is 2.0. HP PA-RISC systems are usually refered to with model
description "HP 9000".
A complete list of models at the time the OS was built is in the file
/usr/sam/lib/mo/sched.models. The first column corresponds to the last
part of the output of the "model" command. The second column is the
PA-RISC version and the third column is the exact chip type used.
(Start browsing at the bottom to prevent confusion ;-)
# model
9000/800/L1000-44
# grep L1000-44 /usr/sam/lib/mo/sched.models
L1000-44 2.0 PA8500
=head2 Portability Between PA-RISC Versions
An executable compiled on a PA-RISC 2.0 platform will not execute on a
PA-RISC 1.1 platform, even if they are running the same version of
HP-UX. If you are building Perl on a PA-RISC 2.0 platform and want that
Perl to also run on a PA-RISC 1.1, the compiler flags +DAportable and
+DS32 should be used.
It is no longer possible to compile PA-RISC 1.0 executables on either
the PA-RISC 1.1 or 2.0 platforms. The command-line flags are accepted,
but the resulting executable will not run when transferred to a PA-RISC
1.0 system.
=head2 PA-RISC 1.0
The original version of PA-RISC, HP no longer sells any system with this chip.
The following systems contained PA-RISC 1.0 chips:
600, 635, 645, 808, 815, 822, 825, 832, 834, 835, 840, 842, 845, 850,
852, 855, 860, 865, 870, 890
=head2 PA-RISC 1.1
An upgrade to the PA-RISC design, it shipped for many years in many different
system.
The following systems contain with PA-RISC 1.1 chips:
705, 710, 712, 715, 720, 722, 725, 728, 730, 735, 742, 743, 744, 745,
747, 750, 755, 770, 777, 778, 779, 800, 801, 803, 806, 807, 809, 811,
813, 816, 817, 819, 821, 826, 827, 829, 831, 837, 839, 841, 847, 849,
851, 856, 857, 859, 867, 869, 877, 887, 891, 892, 897, A180, A180C,
B115, B120, B132L, B132L+, B160L, B180L, C100, C110, C115, C120,
C160L, D200, D210, D220, D230, D250, D260, D310, D320, D330, D350,
D360, D410, DX0, DX5, DXO, E25, E35, E45, E55, F10, F20, F30, G30,
G40, G50, G60, G70, H20, H30, H40, H50, H60, H70, I30, I40, I50, I60,
I70, J200, J210, J210XC, K100, K200, K210, K220, K230, K400, K410,
K420, S700i, S715, S744, S760, T500, T520
=head2 PA-RISC 2.0
The most recent upgrade to the PA-RISC design, it added support for
64-bit integer data.
As of the date of this document's last update, the following systems
contain PA-RISC 2.0 chips:
700, 780, 781, 782, 783, 785, 802, 804, 810, 820, 861, 871, 879, 889,
893, 895, 896, 898, 899, A400, A500, B1000, B2000, C130, C140, C160,
C180, C180+, C180-XP, C200+, C400+, C3000, C360, C3600, CB260, D270,
D280, D370, D380, D390, D650, J220, J2240, J280, J282, J400, J410,
J5000, J5500XM, J5600, J7000, J7600, K250, K260, K260-EG, K270, K360,
K370, K380, K450, K460, K460-EG, K460-XP, K470, K570, K580, L1000,
L2000, L3000, N4000, R380, R390, SD16000, SD32000, SD64000, T540,
T600, V2000, V2200, V2250, V2500, V2600
Just before HP took over Compaq, some systems were renamed. the link
that contained the explanation is dead, so here's a short summary:
HP 9000 A-Class servers, now renamed HP Server rp2400 series.
HP 9000 L-Class servers, now renamed HP Server rp5400 series.
HP 9000 N-Class servers, now renamed HP Server rp7400.
rp2400, rp2405, rp2430, rp2450, rp2470, rp3410, rp3440, rp4410,
rp4440, rp5400, rp5405, rp5430, rp5450, rp5470, rp7400, rp7405,
rp7410, rp7420, rp8400, rp8420, Superdome
The current naming convention is:
aadddd
||||`+- 00 - 99 relative capacity & newness (upgrades, etc.)
|||`--- unique number for each architecture to ensure different
||| systems do not have the same numbering across
||| architectures
||`---- 1 - 9 identifies family and/or relative positioning
||
|`----- c = ia32 (cisc)
| p = pa-risc
| x = ia-64 (Itanium & Itanium 2)
| h = housing
`------ t = tower
r = rack optimized
s = super scalable
b = blade
sa = appliance
=head2 Itanium Processor Family and HP-UX
HP-UX also runs on the new Itanium processor. This requires the use
of a different version of HP-UX (currently 11.23 or 11i v2), and with
the exception of a few differences detailed below and in later sections,
Perl should compile with no problems.
Although PA-RISC binaries can run on Itanium systems, you should not
attempt to use a PA-RISC version of Perl on an Itanium system. This is
because shared libraries created on an Itanium system cannot be loaded
while running a PA-RISC executable.
HP Itanium 2 systems are usually refered to with model description
"HP Integrity".
=head2 Itanium & Itanium 2
HP also ships servers with the 128-bit Itanium processor(s). As of the
date of this document's last update, the following systems contain
Itanium or Itanium 2 chips (this is very likely to be out of date):
BL60p, rx1600, rx1620, rx2600, rx2600hptc, rx2620, rx4610, rx4640,
rx5670, rx7620, rx8620, rx9610
To see all about your machine, type
# model
ia64 hp server rx2600
# /usr/contrib/bin/machinfo
=head2 Building Dynamic Extensions on HP-UX
HP-UX supports dynamically loadable libraries (shared libraries).
Shared libraries end with the suffix .sl. On Itanium systems,
they end with the suffix .so.
Shared libraries created on a platform using a particular PA-RISC
version are not usable on platforms using an earlier PA-RISC version by
default. However, this backwards compatibility may be enabled using the
same +DAportable compiler flag (with the same PA-RISC 1.0 caveat
mentioned above).
Shared libraries created on an Itanium platform cannot be loaded on
a PA-RISC platform. Shared libraries created on a PA-RISC platform
can only be loaded on an Itanium platform if it is a PA-RISC executable
that is attempting to load the PA-RISC library. A PA-RISC shared
library cannot be loaded into an Itanium executable nor vice-versa.
To create a shared library, the following steps must be performed:
1. Compile source modules with +z or +Z flag to create a .o module
which contains Position-Independent Code (PIC). The linker will
tell you in the next step if +Z was needed.
(For gcc, the appropriate flag is -fpic or -fPIC.)
2. Link the shared library using the -b flag. If the code calls
any functions in other system libraries (e.g., libm), it must
be included on this line.
(Note that these steps are usually handled automatically by the extension's
Makefile).
If these dependent libraries are not listed at shared library creation
time, you will get fatal "Unresolved symbol" errors at run time when the
library is loaded.
You may create a shared library that refers to another library, which
may be either an archive library or a shared library. If this second
library is a shared library, this is called a "dependent library". The
dependent library's name is recorded in the main shared library, but it
is not linked into the shared library. Instead, it is loaded when the
main shared library is loaded. This can cause problems if you build an
extension on one system and move it to another system where the
libraries may not be located in the same place as on the first system.
If the referred library is an archive library, then it is treated as a
simple collection of .o modules (all of which must contain PIC). These
modules are then linked into the shared library.
Note that it is okay to create a library which contains a dependent
library that is already linked into perl.
Some extensions, like DB_File and Compress::Zlib use/require prebuilt
libraries for the perl extensions/modules to work. If these libraries
are built using the default configuration, it might happen that you
run into an error like "invalid loader fixup" during load phase.
HP is aware of this problem. Search the HP-UX cxx-dev forums for
discussions about the subject. The short answer is that B<everything>
(all libraries, everything) must be compiled with C<+z> or C<+Z> to be
PIC (position independent code). (For gcc, that would be
C<-fpic> or C<-fPIC>). In HP-UX 11.00 or newer the linker
error message should tell the name of the offending object file.
A more general approach is to intervene manually, as with an example for
the DB_File module, which requires SleepyCat's libdb.sl:
# cd .../db-3.2.9/build_unix
# vi Makefile
... add +Z to all cflags to create shared objects
CFLAGS= -c $(CPPFLAGS) +Z -Ae +O2 +Onolimit \
-I/usr/local/include -I/usr/include/X11R6
CXXFLAGS= -c $(CPPFLAGS) +Z -Ae +O2 +Onolimit \
-I/usr/local/include -I/usr/include/X11R6
# make clean
# make
# mkdir tmp
# cd tmp
# ar x ../libdb.a
# ld -b -o libdb-3.2.sl *.o
# mv libdb-3.2.sl /usr/local/lib
# rm *.o
# cd /usr/local/lib
# rm -f libdb.sl
# ln -s libdb-3.2.sl libdb.sl
# cd .../DB_File-1.76
# make distclean
# perl Makefile.PL
# make
# make test
# make install
As of db-4.2.x it is no longer needed to do this by hand. Sleepycat
has changed the configuration process to add +z on HP-UX automatically.
# cd .../db-4.2.25/build_unix
# env CFLAGS=+DA2.0w LDFLAGS=+DA2.0w ../dist/configure
should work to generate 64bit shared libraries for HP-UX 11.00 and 11i.
It is no longer possible to link PA-RISC 1.0 shared libraries (even
though the command-line flags are still present).
PA-RISC and Itanium object files are not interchangeable. Although
you may be able to use ar to create an archive library of PA-RISC
object files on an Itanium system, you cannot link against it using
an Itanium link editor.
=head2 The HP ANSI C Compiler
When using this compiler to build Perl, you should make sure that the
flag -Aa is added to the cpprun and cppstdin variables in the config.sh
file (though see the section on 64-bit perl below). If you are using a
recent version of the Perl distribution, these flags are set automatically.
=head2 The GNU C Compiler
When you are going to use the GNU C compiler (gcc), and you don't have
gcc yet, you can either build it yourself from the sources (available
from e.g. http://www.gnu.ai.mit.edu/software/gcc/releases.html) or fetch
a prebuilt binary from the HP porting center. There are two places where
gcc prebuilds can be fetched; the first and best (for HP-UX 11 only) is
http://h21007.www2.hp.com/dspp/tech/tech_TechSoftwareDetailPage_IDX/1,1703,547,00.html
the second is http://hpux.cs.utah.edu/hppd/hpux/Gnu/ where you can also
find the GNU binutils package. (Browse through the list, because there
are often multiple versions of the same package available).
Above mentioned distributions are depots. H.Merijn Brand has made prebuilt
gcc binaries available on http://mirrors.develooper.com/hpux/ and/or
http://www.cmve.net/~merijn/ for HP-UX 10.20, HP-UX 11.00, and HP-UX 11.11
(HP-UX 11i) in both 32- and 64-bit versions. These are bzipped tar archives
that also include recent GNU binutils and GNU gdb. Read the instructions
on that page to rebuild gcc using itself.
On PA-RISC you need a different compiler for 32-bit applications and for
64-bit applications. On PA-RISC, 32-bit objects and 64-bit objects do
not mix. Period. There is no different behaviour for HP C-ANSI-C or GNU
gcc. So if you require your perl binary to use 64-bit libraries, like
Oracle-64bit, you MUST build a 64-bit perl.
Building a 64-bit capable gcc on PA-RISC from source is possible only when
you have the HP C-ANSI C compiler or an already working 64-bit binary of
gcc available. Best performance for perl is achieved with HP's native
compiler.
=head2 Using Large Files with Perl on HP-UX
Beginning with HP-UX version 10.20, files larger than 2GB (2^31 bytes)
may be created and manipulated. Three separate methods of doing this
are available. Of these methods, the best method for Perl is to compile
using the -Duselargefiles flag to Configure. This causes Perl to be
compiled using structures and functions in which these are 64 bits wide,
rather than 32 bits wide. (Note that this will only work with HP's ANSI
C compiler. If you want to compile Perl using gcc, you will have to get
a version of the compiler that supports 64-bit operations. See above for
where to find it.)
There are some drawbacks to this approach. One is that any extension
which calls any file-manipulating C function will need to be recompiled
(just follow the usual "perl Makefile.PL; make; make test; make install"
procedure).
The list of functions that will need to recompiled is:
creat, fgetpos, fopen,
freopen, fsetpos, fstat,
fstatvfs, fstatvfsdev, ftruncate,
ftw, lockf, lseek,
lstat, mmap, nftw,
open, prealloc, stat,
statvfs, statvfsdev, tmpfile,
truncate, getrlimit, setrlimit
Another drawback is only valid for Perl versions before 5.6.0. This
drawback is that the seek and tell functions (both the builtin version
and POSIX module version) will not perform correctly.
It is strongly recommended that you use this flag when you run
Configure. If you do not do this, but later answer the question about
large files when Configure asks you, you may get a configuration that
cannot be compiled, or that does not function as expected.
=head2 Threaded Perl on HP-UX
It is possible to compile a version of threaded Perl on any version of
HP-UX before 10.30, but it is strongly suggested that you be running on
HP-UX 11.00 at least.
To compile Perl with threads, add -Dusethreads to the arguments of
Configure. Verify that the -D_POSIX_C_SOURCE=199506L compiler flag is
automatically added to the list of flags. Also make sure that -lpthread
is listed before -lc in the list of libraries to link Perl with. The
hints provided for HP-UX during Configure will try very hard to get
this right for you.
HP-UX versions before 10.30 require a separate installation of a POSIX
threads library package. Two examples are the HP DCE package, available
on "HP-UX Hardware Extensions 3.0, Install and Core OS, Release 10.20,
April 1999 (B3920-13941)" or the Freely available PTH package, available
on H.Merijn's site (http://mirrors.develooper.com/hpux/).
If you are going to use the HP DCE package, the library used for threading
is /usr/lib/libcma.sl, but there have been multiple updates of that
library over time. Perl will build with the first version, but it
will not pass the test suite. Older Oracle versions might be a compelling
reason not to update that library, otherwise please find a newer version
in one of the following patches: PHSS_19739, PHSS_20608, or PHSS_23672
reformatted output:
d3:/usr/lib 106 > what libcma-*.1
libcma-00000.1:
HP DCE/9000 1.5 Module: libcma.sl (Export)
Date: Apr 29 1996 22:11:24
libcma-19739.1:
HP DCE/9000 1.5 PHSS_19739-40 Module: libcma.sl (Export)
Date: Sep 4 1999 01:59:07
libcma-20608.1:
HP DCE/9000 1.5 PHSS_20608 Module: libcma.1 (Export)
Date: Dec 8 1999 18:41:23
libcma-23672.1:
HP DCE/9000 1.5 PHSS_23672 Module: libcma.1 (Export)
Date: Apr 9 2001 10:01:06
d3:/usr/lib 107 >
If you choose for the PTH package, use swinstall to install pth in
the default location (/opt/pth), and then make symbolic links to the
libraries from /usr/lib
# cd /usr/lib
# ln -s /opt/pth/lib/libpth* .
For building perl to support Oracle, it needs to be linked with libcl
and libpthread. So even if your perl is an unthreaded build, these
libraries might be required. See "Oracle on HP-UX" below.
=head2 64-bit Perl on HP-UX
Beginning with HP-UX 11.00, programs compiled under HP-UX can take
advantage of the LP64 programming environment (LP64 means Longs and
Pointers are 64 bits wide), in which scalar variables will be able
to hold numbers larger than 2^32 with complete precision. Perl has
proven to be consistent and reliable in 64bit mode since 5.8.1 on
all HP-UX 11.xx.
As of the date of this document, Perl is fully 64-bit compliant on
HP-UX 11.00 and up for both cc- and gcc builds. If you are about to
build a 64-bit perl with GNU gcc, please read the gcc section carefully.
Should a user have the need for compiling Perl in the LP64 environment,
use the -Duse64bitall flag to Configure. This will force Perl to be
compiled in a pure LP64 environment (with the +DD64 flag for HP C-ANSI-C,
with no additional options for GNU gcc 64-bit on PA-RISC, and with
-mlp64 for GNU gcc on Itanium).
If you want to compile Perl using gcc, you will have to get a version of
the compiler that supports 64-bit operations.)
You can also use the -Duse64bitint flag to Configure. Although there
are some minor differences between compiling Perl with this flag versus
the -Duse64bitall flag, they should not be noticeable from a Perl user's
perspective. When configuring -Duse64bitint using a 64bit gcc on a
pa-risc architecture, -Duse64bitint is silently promoted to -Duse64bitall.
In both cases, it is strongly recommended that you use these flags when
you run Configure. If you do not use do this, but later answer the
questions about 64-bit numbers when Configure asks you, you may get a
configuration that cannot be compiled, or that does not function as
expected.
=head2 Oracle on HP-UX
Using perl to connect to Oracle databases through DBI and DBD::Oracle
has caused a lot of people many headaches. Read README.hpux in the
DBD::Oracle for much more information. The reason to mention it here
is that Oracle requires a perl built with libcl and libpthread, the
latter even when perl is build without threads. Building perl using
all defaults, but still enabling to build DBD::Oracle later on can be
achieved using
Configure -A prepend:libswanted='cl pthread ' ...
Do not forget the space before the trailing quote.
Also note that this does not (yet) work with all configurations,
it is known to fail with 64-bit versions of GCC.
=head2 GDBM and Threads on HP-UX
If you attempt to compile Perl with threads on an 11.X system and also
link in the GDBM library, then Perl will immediately core dump when it
starts up. The only workaround at this point is to relink the GDBM
library under 11.X, then relink it into Perl.
=head2 NFS filesystems and utime(2) on HP-UX
If you are compiling Perl on a remotely-mounted NFS filesystem, the test
io/fs.t may fail on test #18. This appears to be a bug in HP-UX and no
fix is currently available.
=head2 perl -P and // and HP-UX
If HP-UX Perl is compiled with flags that will cause problems if the
-P flag of Perl (preprocess Perl code with the C preprocessor before
perl sees it) is used. The problem is that C<//>, being a C++-style
until-end-of-line comment, will disappear along with the remainder
of the line. This means that common Perl constructs like
s/foo//;
will turn into illegal code
s/foo
The workaround is to use some other quoting separator than C<"/">,
like for example C<"!">:
s!foo!!;
=head2 HP-UX Kernel Parameters (maxdsiz) for Compiling Perl
By default, HP-UX comes configured with a maximum data segment size of
64MB. This is too small to correctly compile Perl with the maximum
optimization levels. You can increase the size of the maxdsiz kernel
parameter through the use of SAM.
When using the GUI version of SAM, click on the Kernel Configuration
icon, then the Configurable Parameters icon. Scroll down and select
the maxdsiz line. From the Actions menu, select the Modify Configurable
Parameter item. Insert the new formula into the Formula/Value box.
Then follow the instructions to rebuild your kernel and reboot your
system.
In general, a value of 256MB (or "256*1024*1024") is sufficient for
Perl to compile at maximum optimization.
=head1 nss_delete core dump from op/pwent or op/grent
You may get a bus error core dump from the op/pwent or op/grent
tests. If compiled with -g you will see a stack trace much like
the following:
#0 0xc004216c in () from /usr/lib/libc.2
#1 0xc00d7550 in __nss_src_state_destr () from /usr/lib/libc.2
#2 0xc00d7768 in __nss_src_state_destr () from /usr/lib/libc.2
#3 0xc00d78a8 in nss_delete () from /usr/lib/libc.2
#4 0xc01126d8 in endpwent () from /usr/lib/libc.2
#5 0xd1950 in Perl_pp_epwent () from ./perl
#6 0x94d3c in Perl_runops_standard () from ./perl
#7 0x23728 in S_run_body () from ./perl
#8 0x23428 in perl_run () from ./perl
#9 0x2005c in main () from ./perl
The key here is the C<nss_delete> call. One workaround for this
bug seems to be to create add to the file F</etc/nsswitch.conf>
(at least) the following lines
group: files
passwd: files
Whether you are using NIS does not matter. Amazingly enough,
the same bug also affects Solaris.
=head1 AUTHOR
Jeff Okamoto <okamoto at corp.hp.com>
H.Merijn Brand <h.m.brand at xs4all.nl>
With much assistance regarding shared libraries from Marc Sabatella.
=head1 DATE
Version 0.7.6: 2005-12-20
=cut
--- NEW FILE: sv.h ---
/* sv.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef sv_flags
#undef sv_flags /* Convex has this in <signal.h> for sigvec() */
#endif
/*
=head1 SV Flags
=for apidoc AmU||svtype
An enum of flags for Perl types. These are found in the file B<sv.h>
[...1350 lines suppressed...]
#define isGV(sv) (SvTYPE(sv) == SVt_PVGV)
#define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
#define SvGROW_mutable(sv,len) \
(SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX_mutable(sv))
#define Sv_Grow sv_grow
#define CLONEf_COPY_STACKS 1
#define CLONEf_KEEP_PTR_TABLE 2
#define CLONEf_CLONE_HOST 4
#define CLONEf_JOIN_IN 8
struct clone_params {
AV* stashes;
UV flags;
PerlInterpreter *proto_perl;
};
#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv)
--- NEW FILE: mg.h ---
/* mg.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
* 2000, 2002, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef STRUCT_MGVTBL_DEFINITION
STRUCT_MGVTBL_DEFINITION;
#else
struct mgvtbl {
int (CPERLscope(*svt_get)) (pTHX_ SV *sv, MAGIC* mg);
int (CPERLscope(*svt_set)) (pTHX_ SV *sv, MAGIC* mg);
U32 (CPERLscope(*svt_len)) (pTHX_ SV *sv, MAGIC* mg);
int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);
int (CPERLscope(*svt_free)) (pTHX_ SV *sv, MAGIC* mg);
int (CPERLscope(*svt_copy)) (pTHX_ SV *sv, MAGIC* mg,
SV *nsv, const char *name, int namlen);
int (CPERLscope(*svt_dup)) (pTHX_ MAGIC *mg, CLONE_PARAMS *param);
};
#endif
struct magic {
MAGIC* mg_moremagic;
MGVTBL* mg_virtual; /* pointer to magic functions */
U16 mg_private;
char mg_type;
U8 mg_flags;
SV* mg_obj;
char* mg_ptr;
I32 mg_len;
};
#define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */
#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */
#define MGf_REFCOUNTED 2
#define MGf_GSKIP 4
#define MGf_COPY 8
#define MGf_DUP 16
#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR)
#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR)
#define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR)
#define MgPV(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \
SvPV((SV*)((mg)->mg_ptr),lp) : \
(mg)->mg_ptr)
#define MgPV_const(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \
SvPV_const((SV*)((mg)->mg_ptr),lp) : \
(const char*)(mg)->mg_ptr)
#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
SvPV_nolen_const((SV*)((mg)->mg_ptr)) : \
(const char*)(mg)->mg_ptr)
#define SvTIED_mg(sv,how) \
(SvRMAGICAL(sv) ? mg_find((sv),(how)) : Null(MAGIC*))
#define SvTIED_obj(sv,mg) \
((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv)))
--- NEW FILE: uconfig.sh ---
#!/bin/sh
_a='.a'
_o='.o'
afs='false'
afsroot='/afs'
alignbytes='4'
archlib='/usr/local/lib/perl5/5.9/unknown'
archlibexp='/usr/local/lib/perl5/5.9/unknown'
archname='unknown'
asctime_r_proto='0'
bin='/usr/local/bin'
byteorder='1234'
castflags='0'
charsize='1'
clocktype='clock_t'
cpp_stuff='42'
crypt_r_proto='0'
ctermid_r_proto='0'
ctime_r_proto='0'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
d_PRIEUldbl='undef'
d_PRIFUldbl='undef'
d_PRIGUldbl='undef'
d_PRIXU64='undef'
d_PRId64='undef'
d_PRIeldbl='undef'
d_PRIfldbl='undef'
d_PRIgldbl='undef'
d_PRIi64='undef'
d_PRIo64='undef'
d_PRIu64='undef'
d_PRIx64='undef'
d_SCNfldbl='undef'
d__fwalk='undef'
d_access='undef'
d_accessx='undef'
d_aintl='undef'
d_alarm='undef'
d_archlib='undef'
d_asctime_r='undef'
d_atolf='undef'
d_atoll='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_attribute_nonnull='undef'
d_attribute_noreturn='undef'
d_attribute_pure='undef'
d_attribute_unused='undef'
d_attribute_warn_unused_result='undef'
d_bcmp='undef'
d_bcopy='undef'
d_bsd='undef'
d_bsdgetpgrp='undef'
d_bsdsetpgrp='undef'
d_bzero='undef'
d_casti32='undef'
d_castneg='undef'
d_charvspr='undef'
d_chown='undef'
d_chroot='undef'
d_chsize='undef'
d_class='undef'
d_clearenv='undef'
d_closedir='define'
d_cmsghdr_s='undef'
d_const='undef'
d_copysignl='undef'
d_crypt='undef'
d_crypt_r='undef'
d_csh='undef'
d_ctermid_r='undef'
d_ctime_r='undef'
d_cuserid='undef'
d_dbl_dig='undef'
d_dbminitproto='undef'
d_difftime='undef'
d_dirfd='undef'
d_dirnamlen='undef'
d_dlerror='undef'
d_dlopen='undef'
d_dlsymun='undef'
d_dosuid='undef'
d_drand48_r='undef'
d_drand48proto='undef'
d_dup2='undef'
d_eaccess='undef'
d_endgrent='undef'
d_endgrent_r='undef'
d_endhent='undef'
d_endhostent_r='undef'
d_endnent='undef'
d_endnetent_r='undef'
d_endpent='undef'
d_endprotoent_r='undef'
d_endpwent='undef'
d_endpwent_r='undef'
d_endsent='undef'
d_endservent_r='undef'
d_eofnblk='undef'
d_eunice='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
d_fd_macros='undef'
d_fd_set='undef'
d_fds_bits='undef'
d_fgetpos='undef'
d_finite='undef'
d_finitel='undef'
d_flexfnam='undef'
d_flock='undef'
d_flockproto='undef'
d_fork='define'
d_fp_class='undef'
d_fpathconf='undef'
d_fpclass='undef'
d_fpclassify='undef'
d_fpclassl='undef'
d_fpos64_t='undef'
d_frexpl='undef'
d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='undef'
d_fstatfs='undef'
d_fstatvfs='undef'
d_fsync='undef'
d_ftello='undef'
d_ftime='undef'
d_futimes='undef'
d_getcwd='undef'
d_getespwnam='undef'
d_getfsstat='undef'
d_getgrent='undef'
d_getgrent_r='undef'
d_getgrgid_r='undef'
d_getgrnam_r='undef'
d_getgrps='undef'
d_gethbyaddr='undef'
d_gethbyname='undef'
d_gethent='undef'
d_gethname='undef'
d_gethostbyaddr_r='undef'
d_gethostbyname_r='undef'
d_gethostent_r='undef'
d_gethostprotos='undef'
d_getitimer='undef'
d_getlogin='undef'
d_getlogin_r='undef'
d_getmnt='undef'
d_getmntent='undef'
d_getnbyaddr='undef'
d_getnbyname='undef'
d_getnent='undef'
d_getnetbyaddr_r='undef'
d_getnetbyname_r='undef'
d_getnetent_r='undef'
d_getnetprotos='undef'
d_getpagsz='undef'
d_getpbyname='undef'
d_getpbynumber='undef'
d_getpent='undef'
d_getpgid='undef'
d_getpgrp2='undef'
d_getpgrp='undef'
d_getppid='undef'
d_getprior='undef'
d_getprotobyname_r='undef'
d_getprotobynumber_r='undef'
d_getprotoent_r='undef'
d_getprotoprotos='undef'
d_getprpwnam='undef'
d_getpwent='undef'
d_getpwent_r='undef'
d_getpwnam_r='undef'
d_getpwuid_r='undef'
d_getsbyname='undef'
d_getsbyport='undef'
d_getsent='undef'
d_getservbyname_r='undef'
d_getservbyport_r='undef'
d_getservent_r='undef'
d_getservprotos='undef'
d_getspent='undef'
d_getspnam='undef'
d_getspnam_r='undef'
d_gettimeod='undef'
d_gmtime_r='undef'
d_gnulibc='undef'
d_grpasswd='undef'
d_hasmntopt='undef'
d_htonl='undef'
d_ilogbl='undef'
d_index='undef'
d_inetaton='undef'
d_int64_t='undef'
d_isascii='undef'
d_isfinite='undef'
d_isinf='undef'
d_isnan='undef'
d_isnanl='undef'
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='undef'
d_libm_lib_version='undef'
d_link='undef'
d_localtime_r='undef'
d_locconv='undef'
d_lockf='undef'
d_longdbl='undef'
d_longlong='undef'
d_lseekproto='undef'
d_lstat='undef'
d_madvise='undef'
d_malloc_good_size='undef'
d_malloc_size='undef'
d_mblen='undef'
d_mbstowcs='undef'
d_mbtowc='undef'
d_memchr='undef'
d_memcmp='undef'
d_memcpy='undef'
d_memmove='undef'
d_memset='undef'
d_mkdir='undef'
d_mkdtemp='undef'
d_mkfifo='undef'
d_mkstemp='undef'
d_mkstemps='undef'
d_mktime='undef'
d_mmap='undef'
d_modfl='undef'
d_modflproto='undef'
d_modfl_pow32_bug='undef'
d_mprotect='undef'
d_msg='undef'
d_msg_ctrunc='undef'
d_msg_dontroute='undef'
d_msg_oob='undef'
d_msg_peek='undef'
d_msg_proxy='undef'
d_msgctl='undef'
d_msgget='undef'
d_msghdr_s='undef'
d_msgrcv='undef'
d_msgsnd='undef'
d_msync='undef'
d_munmap='undef'
d_mymalloc='undef'
d_nice='undef'
d_nl_langinfo='undef'
d_nv_preserves_uv='undef'
d_nv_zero_is_allbits_zero='undef'
nv_preserves_uv_bits='0'
d_off64_t='undef'
d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
d_pathconf='undef'
d_pause='undef'
d_perl_otherlibdirs='undef'
d_phostname='undef'
d_pipe='undef'
d_poll='undef'
d_portable='undef'
d_procselfexe='undef'
d_pthread_atfork='undef'
d_pthread_attr_setscope='undef'
d_pthread_yield='undef'
d_pwage='undef'
d_pwchange='undef'
d_pwclass='undef'
d_pwcomment='undef'
d_pwexpire='undef'
d_pwgecos='undef'
d_pwpasswd='undef'
d_pwquota='undef'
d_qgcvt='undef'
d_quad='undef'
d_random_r='undef'
d_readdir64_r='undef'
d_readdir='define'
d_readdir_r='undef'
d_readlink='undef'
d_readv='undef'
d_recvmsg='undef'
d_rename='define'
d_rewinddir='undef'
d_rmdir='undef'
d_safebcpy='undef'
d_safemcpy='undef'
d_sanemcmp='undef'
d_sbrkproto='undef'
d_scalbnl='undef'
d_sched_yield='undef'
d_scm_rights='undef'
d_seekdir='undef'
d_select='undef'
d_sem='undef'
d_semctl='undef'
d_semctl_semid_ds='undef'
d_semctl_semun='undef'
d_semget='undef'
d_semop='undef'
d_sendmsg='undef'
d_setegid='undef'
d_seteuid='undef'
d_setgrent='undef'
d_setgrent_r='undef'
d_setgrps='undef'
d_sethent='undef'
d_sethostent_r='undef'
d_setitimer='undef'
d_setlinebuf='undef'
d_setlocale='undef'
d_setlocale_r='undef'
d_setnent='undef'
d_setnetent_r='undef'
d_setpent='undef'
d_setpgid='undef'
d_setpgrp2='undef'
d_setpgrp='undef'
d_setprior='undef'
d_setproctitle='undef'
d_setprotoent_r='undef'
d_setpwent='undef'
d_setpwent_r='undef'
d_setregid='undef'
d_setresgid='undef'
d_setresuid='undef'
d_setreuid='undef'
d_setrgid='undef'
d_setruid='undef'
d_setsent='undef'
d_setservent_r='undef'
d_setsid='undef'
d_setvbuf='undef'
d_sfio='undef'
d_shm='undef'
d_shmat='undef'
d_shmatprototype='undef'
d_shmctl='undef'
d_shmdt='undef'
d_shmget='undef'
d_sigaction='undef'
d_sigprocmask='undef'
d_sigsetjmp='undef'
d_sockatmark='undef'
d_snprintf='undef'
d_sockatmarkproto='undef'
d_socket='undef'
d_socklen_t='undef'
d_sockpair='undef'
d_socks5_init='undef'
d_sprintf_returns_strlen='undef'
d_sqrtl='undef'
d_srand48_r='undef'
d_srandom_r='undef'
d_sresgproto='undef'
d_sresuproto='undef'
d_statblks='undef'
d_statfs_f_flags='undef'
d_statfs_s='undef'
d_statvfs='undef'
d_stdio_cnt_lval='undef'
d_stdio_ptr_lval='undef'
d_stdio_ptr_lval_nochange_cnt='undef'
d_stdio_ptr_lval_sets_cnt='undef'
d_stdio_stream_array='undef'
d_stdiobase='undef'
d_stdstdio='undef'
d_strchr='undef'
d_strcoll='undef'
d_strctcpy='undef'
d_strerrm='strerror(e)'
d_strerror='undef'
d_strerror_r='undef'
d_strftime='undef'
d_strlcat='undef'
d_strlcpy='undef'
d_strtod='undef'
d_strtol='undef'
d_strtold='undef'
d_strtoll='undef'
d_strtoq='undef'
d_strtoul='define'
d_strtoull='undef'
d_strtouq='undef'
d_strxfrm='undef'
d_suidsafe='undef'
d_symlink='undef'
d_syscall='undef'
d_syscallproto='undef'
d_sysconf='undef'
d_sysernlst=''
d_syserrlst='undef'
d_system='undef'
d_tcgetpgrp='undef'
d_tcsetpgrp='undef'
d_telldir='undef'
d_telldirproto='undef'
d_time='define'
d_times='undef'
d_tm_tm_gmtoff='undef'
d_tm_tm_zone='undef'
d_tmpnam_r='undef'
d_truncate='undef'
d_ttyname_r='undef'
d_tzname='undef'
d_u32align='define'
d_ualarm='undef'
d_umask='undef'
d_uname='undef'
d_union_semun='undef'
d_unordered='undef'
d_unsetenv='undef'
d_usleep='undef'
d_usleepproto='undef'
d_ustat='undef'
d_vendorarch='undef'
d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
d_void_closedir='undef'
d_voidsig='undef'
d_voidtty=''
d_volatile='undef'
d_vprintf='define'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='undef'
d_wcstombs='undef'
d_wctomb='undef'
d_writev='undef'
d_xenix='undef'
db_hashtype='u_int32_t'
db_prefixtype='size_t'
defvoidused=1
direntrytype='struct dirent'
doublesize='8'
drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))"
drand48_r_proto='0'
eagain='EAGAIN'
ebcdic='undef'
endgrent_r_proto='0'
endhostent_r_proto='0'
endnetent_r_proto='0'
endprotoent_r_proto='0'
endpwent_r_proto='0'
endservent_r_proto='0'
fflushNULL='undef'
fflushall='undef'
firstmakefile='makefile'
fpossize='4'
fpostype=int
freetype=int
getgrent_r_proto='0'
getgrgid_r_proto='0'
getgrnam_r_proto='0'
gethostbyaddr_r_proto='0'
gethostbyname_r_proto='0'
gethostent_r_proto='0'
getlogin_r_proto='0'
getnetbyaddr_r_proto='0'
getnetbyname_r_proto='0'
getnetent_r_proto='0'
getprotobyname_r_proto='0'
getprotobynumber_r_proto='0'
getprotoent_r_proto='0'
getpwent_r_proto='0'
getpwnam_r_proto='0'
getpwuid_r_proto='0'
getservbyname_r_proto='0'
getservbyport_r_proto='0'
getservent_r_proto='0'
getspnam_r_proto='0'
gidformat='"lu"'
gidsign='1'
gidsize='4'
gidtype=int
gmtime_r_proto='0'
groupstype=int
h_fcntl='false'
h_sysfile='true'
i16size='2'
i16type='short'
i32size='4'
i32type='long'
i64size='8'
i64type='int64_t'
i8size='1'
i8type='char'
i_arpainet='undef'
i_bsdioctl=''
i_crypt='undef'
i_db='undef'
i_dbm='undef'
i_dirent='define'
i_dld='undef'
i_dlfcn='undef'
i_fcntl='undef'
i_float='undef'
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
i_langinfo='undef'
i_libutil='undef'
i_limits='undef'
i_locale='undef'
i_machcthr='undef'
i_malloc='undef'
i_math='define'
i_memory='undef'
i_mntent='undef'
i_ndbm='undef'
i_netdb='undef'
i_neterrno='undef'
i_netinettcp='undef'
i_niin='undef'
i_poll='undef'
i_prot='undef'
i_pthread='undef'
i_pwd='undef'
i_rpcsvcdbm='undef'
i_sfio='undef'
i_sgtty='undef'
i_shadow='undef'
i_socks='undef'
i_stdarg='define'
i_stddef='undef'
i_stdlib='define'
i_string='define'
i_sunmath='undef'
i_sysaccess='undef'
i_sysdir='undef'
i_sysfile='undef'
i_sysfilio='undef'
i_sysin='undef'
i_sysioctl='undef'
i_syslog='undef'
i_sysmman='undef'
i_sysmode='undef'
i_sysmount='undef'
i_sysndir='undef'
i_sysparam='undef'
i_sysresrc='undef'
i_syssecrt='undef'
i_sysselct='undef'
i_syssockio='undef'
i_sysstat='define'
i_sysstatfs='undef'
i_sysstatvfs='undef'
i_systime='undef'
i_systimek='undef'
i_systimes='undef'
i_systypes='undef'
i_sysuio='undef'
i_sysun='undef'
i_sysutsname='undef'
i_sysvfs='undef'
i_syswait='undef'
i_termio='undef'
i_termios='undef'
i_time='define'
i_unistd='undef'
i_ustat='undef'
i_utime='undef'
i_values='undef'
i_varargs='undef'
i_varhdr='stdarg.h'
i_vfork='undef'
ignore_versioned_solibs='y'
inc_version_list_init='NULL'
installstyle='lib/perl5'
installusrbinperl='undef'
intsize='4'
ivdformat='"ld"'
ivsize='4'
ivtype='long'
lib_ext='.a'
localtime_r_proto='0'
longdblsize=8
longlongsize=8
longsize='4'
lseeksize=4
lseektype=int
malloctype='int*'
malloctype='void *'
modetype='mode_t'
modetype=int
multiarch='undef'
myarchname='unknown'
myuname='unknown'
need_va_copy='undef'
netdb_hlen_type='int'
netdb_host_type='const char *'
netdb_name_type='const char *'
netdb_net_type='unsigned long'
nroff='nroff'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
nvsize='8'
nvtype='double'
o_nonblock='O_NONBLOCK'
obj_ext='.o'
optimize='-O2'
orderlib='false'
osname='unknown'
phostname='hostname'
pidtype=int
privlib='/usr/local/lib/perl5/5.9'
privlibexp='/usr/local/lib/perl5/5.9'
procselfexe=''
prototype='undef'
ptrsize='4'
quadkind='4'
quadtype='int64_t'
randbits='48'
randfunc='drand48'
random_r_proto='0'
randseedtype='int'
rd_nodata='-1'
readdir64_r_proto='0'
readdir_r_proto='0'
sPRIEUldbl='"llE"'
sPRIFUldbl='"llF"'
sPRIGUldbl='"llG"'
sPRIXU64='"LX"'
sPRId64='"Ld"'
sPRIeldbl='"lle"'
sPRIfldbl='"llf"'
sPRIgldbl='"llg"'
sPRIi64='"Li"'
sPRIo64='"Lo"'
sPRIu64='"Lu"'
sPRIx64='"Lx"'
sSCNfldbl='"llf"'
sched_yield='sched_yield()'
scriptdir='/usr/local/bin'
scriptdirexp='/usr/local/bin'
seedfunc='srand'
selectminbits='32'
selecttype=int
setgrent_r_proto='0'
sethostent_r_proto='0'
setlocale_r_proto='0'
setnetent_r_proto='0'
setprotoent_r_proto='0'
setpwent_r_proto='0'
setservent_r_proto='0'
shmattype='void *'
shortsize=2
sig_name_init='0'
sig_num_init='0'
sig_size='1'
signal_t=int
sizesize=4
sizetype='size_t'
socksizetype='int'
srand48_r_proto='0'
srandom_r_proto='0'
ssizetype=int
stdchar=char
stdio_base='((fp)->_IO_read_base)'
stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)'
stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
stdio_filbuf=''
stdio_ptr='((fp)->_IO_read_ptr)'
stdio_stream_array=''
strerror_r_proto='0'
timetype=time_t
tmpnam_r_proto='0'
touch='touch'
ttyname_r_proto='0'
u16size='2'
u16type='unsigned short'
u32size='4'
u32type='unsigned long'
u64size='8'
u64type='uint64_t'
u8size='1'
u8type='unsigned char'
uidformat='"lu"'
uidsign='1'
uidsize='4'
uidtype=int
uquadtype='uint64_t'
use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usecrosscompile='undef'
usedl='undef'
usefaststdio='undef'
useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
usemallocwrap='undef'
usemorebits='undef'
usemultiplicity='undef'
usemymalloc='n'
usenm='false'
useopcode='true'
useperlio='undef'
useposix='true'
usereentrant='undef'
userelocatableinc='undef'
usesfio='false'
useshrplib='false'
usesitecustomize='undef'
usesocks='undef'
usethreads='undef'
usevendorprefix='undef'
usevfork='false'
uvXUformat='"lX"'
uvoformat='"lo"'
uvsize='4'
uvtype='unsigned long'
uvuformat='"lu"'
uvxformat='"lx"'
versiononly='undef'
voidflags=1
--- NEW FILE: mg.c ---
/* mg.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "Sam sat on the ground and put his head in his hands. 'I wish I had never
* come here, and I don't want to see no more magic,' he said, and fell silent."
*/
/*
=head1 Magical Functions
"Magic" is special data attached to SV structures in order to give them
[...2744 lines suppressed...]
const U32 flags = *(const U32*)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(PL_sig_sv);
#endif
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: sv.c ---
/* sv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* "I wonder what the Entish is for 'yes' and 'no'," he thought.
*
*
* This file contains the code that creates, manipulates and destroys
* scalar values (SVs). The other types (AV, HV, GV, etc.) reuse the
* structure of an SV, so their creation and destruction is handled
* here; higher-level functions are in av.c, hv.c, and so on. Opcode
* level functions (eg. substr, split, join) for each of the types are
* in the pp*.c files.
*/
[...11794 lines suppressed...]
ret = SvTRUE(TOPs);
*offset = SvIV(offsv);
PUTBACK;
FREETMPS;
LEAVE;
}
else
Perl_croak(aTHX_ "Invalid argument to sv_cat_decode");
return ret;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: writemain.SH ---
case $PERL_CONFIG_SH in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
elif test -f ../../config.sh; then TOP=../..;
elif test -f ../../../config.sh; then TOP=../../..;
elif test -f ../../../../config.sh; then TOP=../../../..;
else
echo "Can't find config.sh."; exit 1
fi
. $TOP/config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting writemain (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front. You may delete these comments.
rm -f writemain
$spitshell >writemain <<!GROK!THIS!
$startsh
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>writemain <<'!NO!SUBS!'
# This script takes the plain miniperlmain.c and writes out perlmain.c
# which includes all the extensions.
# The command line arguments name extensions to be used.
# E.g.: sh writemain SDBM_File POSIX > perlmain.c
#
orig="$*"
args=''
: Remove any .a suffixes and any leading path components
for file in $orig ; do
case "$file" in
*.a) file=`echo $file | sed 's/\.a//g'`
;;
esac
case "$file" in
ext/*) file=`echo $file | sed 's:ext/\(.*\)/[^/]*:\1:'`
;;
lib/auto/*) file=`echo $file | sed 's:lib/auto/\(.*\)/[^/]*:\1:'`
;;
*/*)
file=`expr X$file : 'X.*/\(.*\)'`
;;
esac
args="$args $file"
done
sed '/Do not delete this line--writemain depends on it/q' miniperlmain.c
if test X"$args" != "X" ; then
for ext in $args ; do
: $ext will either be 'Name' or 'Name1/Name2' etc
: convert ext into cname and mname
mname=`echo $ext | sed 's!/!::!g'`
cname=`echo $mname | sed 's!:!_!g'`
echo "EXTERN_C void boot_${cname} (pTHX_ CV* cv);"
done
fi
cat << 'EOP'
static void
xs_init(pTHX)
{
EOP
if test X"$args" != "X" ; then
echo " const char file[] = __FILE__;"
echo " dXSUB_SYS;"
ai=''
for ext in $args ; do
: $ext will either be 'Name' or 'Name1/Name2' etc
: convert ext into cname and mname
mname=`echo $ext | sed 's!/!::!g'`
cname=`echo $mname | sed 's!:!_!g'`
if test "$ext" = "DynaLoader"; then
: Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
: boot_DynaLoader is called directly in DynaLoader.pm
echo " newXS(\"${mname}::boot_${ext}\", boot_${cname}, (char *)file);"
else
echo " newXS(\"${mname}::bootstrap\", boot_${cname}, (char *)file);"
fi
done
fi
cat << 'EOP'
}
EOP
!NO!SUBS!
chmod 755 writemain
$eunicefix writemain
--- NEW FILE: av.c ---
/* av.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "...for the Entwives desired order, and plenty, and peace (by which they
* meant that things should remain where they had set them)." --Treebeard
*/
/*
=head1 Array Manipulation Functions
*/
[...1017 lines suppressed...]
HV *keys = avhv_keys(av);
return hv_iternext(keys);
}
SV *
Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
{
SV *sv = hv_iterval(avhv_keys(av), entry);
return *av_fetch(av, avhv_index_sv(sv), TRUE);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: cc_runtime.h ---
/* cc_runtime.h
*
* Copyright (C) 1999, 2000, 2001, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#define DOOP(ppname) PUTBACK; PL_op = ppname(aTHX); SPAGAIN
#define CCPP(s) OP * s(pTHX)
#define PP_LIST(g) do { \
dMARK; \
if (g != G_ARRAY) { \
if (++MARK <= SP) \
*MARK = *SP; \
else \
*MARK = &PL_sv_undef; \
SP = MARK; \
} \
} while (0)
#define MAYBE_TAINT_SASSIGN_SRC(sv) \
if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \
!((mg=mg_find(left, PERL_MAGIC_taint)) && mg->mg_len & 1)))\
TAINT_NOT
#define PP_PREINC(sv) do { \
if (SvIOK(sv)) { \
++SvIVX(sv); \
SvFLAGS(sv) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); \
} \
else \
sv_inc(sv); \
SvSETMAGIC(sv); \
} while (0)
#define PP_UNSTACK do { \
TAINT_NOT; \
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; \
FREETMPS; \
oldsave = PL_scopestack[PL_scopestack_ix - 1]; \
LEAVE_SCOPE(oldsave); \
SPAGAIN; \
} while(0)
/* Anyone using eval "" deserves this mess */
#define PP_EVAL(ppaddr, nxt) do { \
dJMPENV; \
int ret; \
PUTBACK; \
JMPENV_PUSH(ret); \
switch (ret) { \
case 0: \
PL_op = ppaddr(aTHX); \
PL_retstack[PL_retstack_ix - 1] = Nullop; \
if (PL_op != nxt) CALLRUNOPS(); \
JMPENV_POP; \
break; \
case 1: JMPENV_POP; JMPENV_JUMP(1); \
case 2: JMPENV_POP; JMPENV_JUMP(2); \
case 3: \
JMPENV_POP; \
if (PL_restartop && PL_restartop != nxt) \
JMPENV_JUMP(3); \
} \
PL_op = nxt; \
SPAGAIN; \
} while (0)
#define PP_ENTERTRY(jmpbuf,label) \
STMT_START { \
int ret; \
JMPENV_PUSH_ENV(jmpbuf,ret); \
switch (ret) { \
case 1: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(1);\
case 2: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(2);\
case 3: JMPENV_POP_ENV(jmpbuf); SPAGAIN; goto label;\
} \
} STMT_END
#define PP_LEAVETRY \
STMT_START{ PL_top_env=PL_top_env->je_prev; }STMT_END
--- NEW FILE: regcomp.pl ---
BEGIN {
# Get function prototypes
require 'regen_lib.pl';
}
#use Fatal qw(open close rename chmod unlink);
open DESC, 'regcomp.sym';
$ind = 0;
while (<DESC>) {
next if /^\s*($|\#)/;
$ind++;
chomp;
($name[$ind], $desc, $rest[$ind]) = split /\t+/, $_, 3;
($type[$ind], $code[$ind], $args[$ind], $longj[$ind])
= split /[,\s]\s*/, $desc, 4;
}
close DESC;
$tot = $ind;
$tmp_h = 'tmp_reg.h';
unlink $tmp_h if -f $tmp_h;
open OUT, ">$tmp_h";
binmode OUT;
print OUT <<EOP;
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by regcomp.pl from regcomp.sym.
Any changes made here will be lost!
*/
EOP
$ind = 0;
while (++$ind <= $tot) {
$oind = $ind - 1;
$hind = sprintf "%#4x", $oind;
print OUT <<EOP;
#define $name[$ind] $oind /* $hind $rest[$ind] */
EOP
}
print OUT <<EOP;
#ifndef DOINIT
EXTCONST U8 PL_regkind[];
#else
EXTCONST U8 PL_regkind[] = {
EOP
$ind = 0;
while (++$ind <= $tot) {
print OUT <<EOP;
$type[$ind], /* $name[$ind] */
EOP
}
print OUT <<EOP;
};
#endif
#ifdef REG_COMP_C
static const U8 regarglen[] = {
EOP
$ind = 0;
while (++$ind <= $tot) {
$size = 0;
$size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind];
print OUT <<EOP;
$size, /* $name[$ind] */
EOP
}
print OUT <<EOP;
};
static const char reg_off_by_arg[] = {
EOP
$ind = 0;
while (++$ind <= $tot) {
$size = $longj[$ind] || 0;
print OUT <<EOP;
$size, /* $name[$ind] */
EOP
}
print OUT <<EOP;
};
#ifdef DEBUGGING
static const char * const reg_name[] = {
EOP
$ind = 0;
while (++$ind <= $tot) {
$hind = sprintf "%#4x", $ind-1;
$size = $longj[$ind] || 0;
print OUT <<EOP;
"$name[$ind]", /* $hind */
EOP
}
print OUT <<EOP;
};
static const int reg_num = $tot;
#endif /* DEBUGGING */
#endif /* REG_COMP_C */
/* ex: set ro: */
EOP
close OUT or die "close $tmp_h: $!";
safer_rename $tmp_h, 'regnodes.h';
--- NEW FILE: pp_sort.c ---
/* pp_sort.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* ...they shuffled back towards the rear of the line. 'No, not at the
* rear!' the slave-driver shouted. 'Three files up. And stay there...
*/
/* This file contains pp ("push/pop") functions that
* execute the opcodes that make up a perl program. A typical pp function
* expects to find its arguments on the stack, and usually pushes its
* results onto the stack, hence the 'pp' terminology. Each OP structure
[...1907 lines suppressed...]
}
else {
const NV d = SvNV(tmpsv);
if (d > 0)
return 1;
return d? -1 : 0;
}
}
return sv_cmp_locale(str1, str2);
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: configure.gnu ---
#! /bin/sh
#
# $Id: configure.gnu,v 1.2 2006-12-04 16:58:44 dslinux_cayenne Exp $
#
# GNU configure-like front end to metaconfig's Configure.
#
# Written by Andy Dougherty <doughera at lafayette.edu>
# and Matthew Green <mrg at mame.mu.oz.au>.
#
# Reformatted and modified for inclusion in the dist-3.0 package by
# Raphael Manfredi <ram at hptnos02.grenoble.hp.com>.
#
# This script belongs to the public domain and may be freely redistributed.
#
# The remaining of this leading shell comment may be removed if you
# include this script in your own package.
#
# $Log: configure.gnu,v $
# Revision 1.2 2006-12-04 16:58:44 dslinux_cayenne
# Adding fresh perl source to HEAD to branch from
#
# Revision 3.0.1.1 1995/07/25 14:16:21 ram
# patch56: created
#
(exit $?0) || exec sh $0 $argv:q
case "$0" in
*configure)
if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
echo "Your configure and Configure scripts seem to be identical."
echo "This can happen on filesystems that aren't fully case sensitive."
echo "You'll have to explicitly extract Configure and run that."
exit 1
fi
;;
esac
opts=''
verbose=''
create='-e'
while test $# -gt 0; do
case $1 in
--help)
cat <<EOM
Usage: configure.gnu [options]
This is GNU configure-like front end for a metaconfig-generated Configure.
It emulates the following GNU configure options (must be fully spelled out):
--help
--no-create
--prefix=PREFIX
--cache-file (ignored)
--quiet
--silent
--verbose
--version
And it honours these environment variables: CC, CFLAGS and DEFS.
EOM
exit 0
;;
--no-create)
create='-E'
shift
;;
--prefix=*)
arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'`
opts="$opts $arg"
shift
;;
--prefix)
shift
arg="-Dprefix=$1"
opts="$opts $arg"
shift
;;
--cache-file=*)
shift # Just ignore it.
;;
--quiet|--silent)
exec >/dev/null 2>&1
shift
;;
--verbose)
verbose=true
shift
;;
--version)
copt="$copt -V"
shift
;;
--*)
opt=`echo $1 | sed 's/=.*//'`
echo "This GNU configure front end does not understand $opt"
exit 1
;;
*)
opts="$opts '$1'"
shift
;;
esac
done
case "$CC" in
'') ;;
*) opts="$opts -Dcc='$CC'";;
esac
# Join DEFS and CFLAGS together.
ccflags=''
case "$DEFS" in
'') ;;
*) ccflags=$DEFS;;
esac
case "$CFLAGS" in
'') ;;
*) ccflags="$ccflags $CFLAGS";;
esac
case "$ccflags" in
'') ;;
*) opts="$opts -Dccflags='$ccflags'";;
esac
case "$LDFLAGS" in
'') ;;
*) ldflags="$ldflags $LDFLAGS";;
esac
case "$ldflags" in
'') ;;
*) opts="$opts -Dldflags='$ldflags'";;
esac
# Don't use -s if they want verbose mode
case "$verbose" in
'') copt="$copt -ds";;
*) copt="$copt -d";;
esac
eval "set X sh Configure $copt $create $opts"
shift
echo "$@"
exec "$@"
--- NEW FILE: README.tw ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
The following documentation is written in Big5 encoding.
¦pªG§A¥Î¤@¯ëªº¤å¦r½s¿è¾¹¾\Äý³o¥÷¤å¥ó, ½Ð©¿²¤¤å¤¤©_¯Sªºµù°O¦r²Å.
³o¥÷¤å¥ó¬O¥H POD (²©ú¤å¥ó®æ¦¡) ¼g¦¨; ³oºØ®æ¦¡¬O¬°¤F¯àÅý¤Hª½±µÅª¨ú,
¦Ó¯S§O³]pªº. Ãö©ó¦¹®æ¦¡ªº¶i¤@¨B¸ê°T, ½Ð°Ñ¦Ò perlpod ½u¤W¤å¥ó.
=head1 NAME
perltw - ¥¿Å餤¤å Perl «ü«n
=head1 DESCRIPTION
Åwªï¨Ó¨ì Perl ªº¤Ñ¦a!
±q 5.8.0 ª©¶}©l, Perl ¨ã³Æ¤F§¹µ½ªº Unicode (¸U°ê½X) ¤ä´©,
¤]³s±a¤ä´©¤F³\¦h©Ô¤B»y¨t¥H¥~ªº½s½X¤è¦¡; CJK (¤¤¤éÁú) «K¬O¨ä¤¤ªº¤@³¡¥÷.
Unicode ¬O°ê»Ú©Êªº¼Ð·Ç, ¸Õ¹Ï²[»\¥@¬É¤W©Ò¦³ªº¦r²Å: ¦è¤è¥@¬É, ªF¤è¥@¬É,
¥H¤Î¨âªÌ¶¡ªº¤@¤Á (§Æþ¤å, ±Ô§Q¨È¤å, ªü©Ô§B¤å, §Æ§B¨Ó¤å, ¦L«×¤å,
¦L¦a¦w¤å, µ¥µ¥). ¥¦¤]®e¯Ç¤F¦hºØ§@·~¨t²Î»P¥»O (¦p PC ¤Î³Áª÷¶ð).
Perl ¥»¨¥H Unicode ¶i¦æ¾Þ§@. ³oªí¥Ü Perl ¤º³¡ªº¦r¦ê¸ê®Æ¥i¥Î Unicode
ªí¥Ü; Perl ªº¨ç¦¡»Pºâ²Å (¨Ò¦p¥¿³Wªí¥Ü¦¡¤ñ¹ï) ¤]¯à¹ï Unicode ¶i¦æ¾Þ§@.
¦b¿é¤J¤Î¿é¥X®É, ¬°¤F³B²z¥H Unicode ¤§«eªº½s½X¤è¦¡Àx¦sªº¸ê®Æ, Perl
´£¨Ñ¤F Encode ³oÓ¼Ò²Õ, ¥i¥HÅý§A»´©ö¦aŪ¨ú¤Î¼g¤J¦³ªº½s½X¸ê®Æ.
Encode ©µ¦ù¼Ò²Õ¤ä´©¤U¦C¥¿Å餤¤åªº½s½X¤è¦¡ ('big5' ªí¥Ü 'big5-eten'):
big5-eten Big5 ½s½X (§tʤѩµ¦ù¦r§Î)
big5-hkscs Big5 + »´ä¥~¦r¶°, 2001 ¦~ª©
cp950 ¦r½X¶ 950 (Big5 + ·L³n²K¥[ªº¦r²Å)
Á|¨Ò¨Ó»¡, ±N Big5 ½s½XªºÀÉ®×Âন Unicode, ¯»ÝÁä¤J¤U¦C«ü¥O:
perl -Mencoding=big5,STDOUT,utf8 -pe1 < file.big5 > file.utf8
Perl ¤]¤ºªþ¤F "piconv", ¤@¤ä§¹¥þ¥H Perl ¼g¦¨ªº¦r²ÅÂà´«¤u¨ãµ{¦¡, ¥Îªk¦p¤U:
piconv -f big5 -t utf8 < file.big5 > file.utf8
piconv -f utf8 -t big5 < file.utf8 > file.big5
¥t¥~, §Q¥Î encoding ¼Ò²Õ, §A¥i¥H»´©ö¼g¥X¥H¦r²Å¬°³æ¦ìªºµ{¦¡½X, ¦p¤U©Ò¥Ü:
#!/usr/bin/env perl
# ±Ò°Ê big5 ¦r¦ê¸ÑªR; ¼Ð·Ç¿é¥X¤J¤Î¼Ð·Ç¿ù»~³£³]¬° big5 ½s½X
use encoding 'big5', STDIN => 'big5', STDOUT => 'big5';
print length("Àd¾m"); # 2 (Âù¤Þ¸¹ªí¥Ü¦r²Å)
print length('Àd¾m'); # 4 (³æ¤Þ¸¹ªí¥Ü¦ì¤¸²Õ)
print index("½Î½Î±Ð»£", "να"); # -1 (¤£¥]§t¦¹¤l¦r¦ê)
print index('½Î½Î±Ð»£', 'να'); # 1 (±q²Ä¤GӦ줸²Õ¶}©l)
¦b³Ì«á¤@¦C¨Ò¤l¸Ì, "½Î" ªº²Ä¤GӦ줸²Õ»P "½Î" ªº²Ä¤@Ӧ줸²Õµ²¦X¦¨ Big5
½Xªº "ν"; "½Î" ªº²Ä¤GӦ줸²Õ«h»P "±Ð" ªº²Ä¤@Ӧ줸²Õµ²¦X¦¨ "α".
³o¸Ñ¨M¤F¥H«e Big5 ½X¤ñ¹ï³B²z¤W±`¨£ªº°ÝÃD.
=head2 ÃB¥~ªº¤¤¤å½s½X
¦pªG»Ýn§ó¦hªº¤¤¤å½s½X, ¥i¥H±q CPAN (L<http://www.cpan.org/>) ¤U¸ü
Encode::HanExtra ¼Ò²Õ. ¥¦¥Ø«e´£¨Ñ¤U¦C½s½X¤è¦¡:
cccii 1980 ¦~¤å«Ø·|ªº¤¤¤å¸ê°T¥æ´«½X
euc-tw Unix ©µ¦ù¦r²Å¶°, ¥]§t CNS11643 ¥± 1-7
big5plus ¤¤¤å¼Æ¦ì¤Æ§Þ³N±À¼s°òª÷·|ªº Big5+
big5ext ¤¤¤å¼Æ¦ì¤Æ§Þ³N±À¼s°òª÷·|ªº Big5e
¥t¥~, Encode::HanConvert ¼Ò²Õ«h´£¨Ñ¤F²ÁcÂà´«¥Îªº¨âºØ½s½X:
big5-simp Big5 ¥¿Å餤¤å»P Unicode ²Å餤¤å¤¬Âà
gbk-trad GBK ²Å餤¤å»P Unicode ¥¿Å餤¤å¤¬Âà
Y·Q¦b GBK »P Big5 ¤§¶¡¤¬Âà, ½Ð°Ñ¦Ò¸Ó¼Ò²Õ¤ºªþªº b2g.pl »P g2b.pl ¨â¤äµ{¦¡,
©Î¦bµ{¦¡¤º¨Ï¥Î¤U¦C¼gªk:
use Encode::HanConvert;
$euc_cn = big5_to_gb($big5); # ±q Big5 Âର GBK
$big5 = gb_to_big5($euc_cn); # ±q GBK Âର Big5
=head2 ¶i¤@¨Bªº¸ê°T
½Ð°Ñ¦Ò Perl ¤ºªþªº¤j¶q»¡©ú¤å¥ó (¤£©¯¥þ¬O¥Î^¤å¼gªº), ¨Ó¾Ç²ß§ó¦hÃö©ó
Perl ªºª¾ÃÑ, ¥H¤Î Unicode ªº¨Ï¥Î¤è¦¡. ¤£¹L, ¥~³¡ªº¸ê·½¬Û·íÂ×´I:
=head2 ´£¨Ñ Perl ¸ê·½ªººô§}
=over 4
=item L<http://www.perl.com/>
Perl ªºº¶ (¥Ñ¼ÚµÜ§¤½¥qºûÅ@)
=item L<http://www.cpan.org/>
Perl ºî¦X¨åÂúô (Comprehensive Perl Archive Network)
=item L<http://lists.perl.org/>
Perl ¶l»¼½×¾Â¤@Äý
=back
=head2 ¾Ç²ß Perl ªººô§}
=over 4
=item L<http://www.oreilly.com.tw/chinese/perl/index.html>
¥¿Å餤¤åª©ªº¼ÚµÜ§ Perl ®ÑÂÇ
=item L<http://groups.google.com/groups?q=tw.bbs.comp.lang.perl>
»OÆW Perl ³s½u°Q½×°Ï (¤]´N¬O¦U¤j BBS ªº Perl ³s½uª©)
=back
=head2 Perl ¨Ï¥ÎªÌ¶°·|
=over 4
=item L<http://www.pm.org/groups/asia.shtml#Taiwan>
»OÆW Perl ±À¼s²Õ¤@Äý
=item L<http://irc.elixus.org/>
ÃÀ¥ß¨ó½u¤W²á¤Ñ«Ç
=back
=head2 Unicode ¬ÛÃöºô§}
=over 4
=item L<http://www.unicode.org/>
Unicode ¾Ç³N¾Ç·| (Unicode ¼Ð·Çªº¨î©wªÌ)
=item L<http://www.cl.cam.ac.uk/%7Emgk25/unicode.html>
Unix/Linux ¤Wªº UTF-8 ¤Î Unicode µª«È°Ý
=back
=head2 ¤¤¤å¤Æ¸ê°T
=over 4
=item ¬°¤°»ò¥s "¥¿Å餤¤å" ¤£¥s "ÁcÅ餤¤å"?
L<http://www.csie.ntu.edu.tw/~b7506051/mozilla/faq.html#faqglossary>
=item ¤¤¤å¤Æ³nÅéÁp·ù
L<http://www.cpatch.org/>
=item Linux ³nÅ餤¤å¤Æp¹º
L<http://www.linux.org.tw/CLDP/>
=back
=head1 SEE ALSO
L<Encode>, L<Encode::TW>, L<encoding>, L<perluniintro>, L<perlunicode>
=head1 AUTHORS
Jarkko Hietaniemi E<lt>jhi at iki.fiE<gt>
Autrijus Tang (ð©vº~) E<lt>autrijus at autrijus.orgE<gt>
=cut
--- NEW FILE: README.os2 ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see perlpod manpage) which is
specially designed to be readable as is.
=head1 NAME
perlos2 - Perl under OS/2, DOS, Win0.3*, Win0.95 and WinNT.
=head1 SYNOPSIS
One can read this document in the following formats:
man perlos2
view perl perlos2
explorer perlos2.html
info perlos2
to list some (not all may be available simultaneously), or it may
be read I<as is>: either as F<README.os2>, or F<pod/perlos2.pod>.
[...2704 lines suppressed...]
REXX_call {...block...};
Two new functions are supported by REXX code,
REXX_eval 'string';
REXX_eval_with 'string', REXX_function_name => \&perl_sub_reference;
If you have some other extensions you want to share, send the code to
me. At least two are available: tied access to EA's, and tied access
to system databases.
=head1 AUTHOR
Ilya Zakharevich, cpan at ilyaz.org
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE: README.solaris ---
If you read this file _as_is_, just ignore the funny characters you
see. It is written in the POD format (see pod/perlpod.pod) which is
specifically designed to be readable as is.
=head1 NAME
README.solaris - Perl version 5 on Solaris systems
=head1 DESCRIPTION
This document describes various features of Sun's Solaris operating system
that will affect how Perl version 5 (hereafter just perl) is
compiled and/or runs. Some issues relating to the older SunOS 4.x are
also discussed, though they may be out of date.
For the most part, everything should just work.
Starting with Solaris 8, perl5.00503 (or higher) is supplied with the
operating system, so you might not even need to build a newer version
of perl at all. The Sun-supplied version is installed in /usr/perl5
with /usr/bin/perl pointing to /usr/perl5/bin/perl. Do not disturb
that installation unless you really know what you are doing. If you
remove the perl supplied with the OS, you will render some bits of
your system inoperable. If you wish to install a newer version of perl,
install it under a different prefix from /usr/perl5. Common prefixes
to use are /usr/local and /opt/perl.
You may wish to put your version of perl in the PATH of all users by
changing the link /usr/bin/perl. This is probably OK, as most perl
scripts shipped with Solaris use an explicit path. (There are a few
exceptions, such as /usr/bin/rpm2cpio and /etc/rcm/scripts/README, but
these are also sufficiently generic that the actual version of perl
probably doesn't matter too much.)
Solaris ships with a range of Solaris-specific modules. If you choose
to install your own version of perl you will find the source of many of
these modules is available on CPAN under the Sun::Solaris:: namespace.
Solaris may include two versions of perl, e.g. Solaris 9 includes
both 5.005_03 and 5.6.1. This is to provide stability across Solaris
releases, in cases where a later perl version has incompatibilities
with the version included in the preceeding Solaris release. The
default perl version will always be the most recent, and in general
the old version will only be retained for one Solaris release. Note
also that the default perl will NOT be configured to search for modules
in the older version, again due to compatibility/stability concerns.
As a consequence if you upgrade Solaris, you will have to
rebuild/reinstall any additional CPAN modules that you installed for
the previous Solaris version. See the CPAN manpage under 'autobundle'
for a quick way of doing this.
As an interim measure, you may either change the #! line of your
scripts to specifically refer to the old perl version, e.g. on
Solaris 9 use #!/usr/perl5/5.00503/bin/perl to use the perl version
that was the default for Solaris 8, or if you have a large number of
scripts it may be more convenient to make the old version of perl the
default on your system. You can do this by changing the appropriate
symlinks under /usr/perl5 as follows (example for Solaris 9):
# cd /usr/perl5
# rm bin man pod
# ln -s ./5.00503/bin
# ln -s ./5.00503/man
# ln -s ./5.00503/lib/pod
# rm /usr/bin/perl
# ln -s ../perl5/5.00503/bin/perl /usr/bin/perl
In both cases this should only be considered to be a temporary
measure - you should upgrade to the later version of perl as soon as
is practicable.
Note also that the perl command-line utilities (e.g. perldoc) and any
that are added by modules that you install will be under
/usr/perl5/bin, so that directory should be added to your PATH.
=head2 Solaris Version Numbers.
For consistency with common usage, perl's Configure script performs
some minor manipulations on the operating system name and version
number as reported by uname. Here's a partial translation table:
Sun: perl's Configure:
uname uname -r Name osname osvers
SunOS 4.1.3 Solaris 1.1 sunos 4.1.3
SunOS 5.6 Solaris 2.6 solaris 2.6
SunOS 5.8 Solaris 8 solaris 2.8
SunOS 5.9 Solaris 9 solaris 2.9
SunOS 5.10 Solaris 10 solaris 2.10
The complete table can be found in the Sun Managers' FAQ
L<ftp://ftp.cs.toronto.edu/pub/jdd/sunmanagers/faq> under
"9.1) Which Sun models run which versions of SunOS?".
=head1 RESOURCES
There are many, many sources for Solaris information. A few of the
important ones for perl:
=over 4
=item Solaris FAQ
The Solaris FAQ is available at
L<http://www.science.uva.nl/pub/solaris/solaris2.html>.
The Sun Managers' FAQ is available at
L<ftp://ftp.cs.toronto.edu/pub/jdd/sunmanagers/faq>
=item Precompiled Binaries
Precompiled binaries, links to many sites, and much, much more are
available at L<http://www.sunfreeware.com/> and
L<http://www.blastwave.org/>.
=item Solaris Documentation
All Solaris documentation is available on-line at L<http://docs.sun.com/>.
=back
=head1 SETTING UP
=head2 File Extraction Problems on Solaris.
Be sure to use a tar program compiled under Solaris (not SunOS 4.x)
to extract the perl-5.x.x.tar.gz file. Do not use GNU tar compiled
for SunOS4 on Solaris. (GNU tar compiled for Solaris should be fine.)
When you run SunOS4 binaries on Solaris, the run-time system magically
alters pathnames matching m#lib/locale# so that when tar tries to create
lib/locale.pm, a file named lib/oldlocale.pm gets created instead.
If you found this advice too late and used a SunOS4-compiled tar
anyway, you must find the incorrectly renamed file and move it back
to lib/locale.pm.
=head2 Compiler and Related Tools on Solaris.
You must use an ANSI C compiler to build perl. Perl can be compiled
with either Sun's add-on C compiler or with gcc. The C compiler that
shipped with SunOS4 will not do.
=head3 Include /usr/ccs/bin/ in your PATH.
Several tools needed to build perl are located in /usr/ccs/bin/: ar,
as, ld, and make. Make sure that /usr/ccs/bin/ is in your PATH.
You need to make sure the following packages are installed
(this info is extracted from the Solaris FAQ):
for tools (sccs, lex, yacc, make, nm, truss, ld, as): SUNWbtool,
SUNWsprot, SUNWtoo
for libraries & headers: SUNWhea, SUNWarc, SUNWlibm, SUNWlibms, SUNWdfbh,
SUNWcg6h, SUNWxwinc, SUNWolinc
for 64 bit development: SUNWarcx, SUNWbtoox, SUNWdplx, SUNWscpux,
SUNWsprox, SUNWtoox, SUNWlmsx, SUNWlmx, SUNWlibCx
If you are in doubt which package contains a file you are missing,
try to find an installation that has that file. Then do a
$ grep /my/missing/file /var/sadm/install/contents
This will display a line like this:
/usr/include/sys/errno.h f none 0644 root bin 7471 37605 956241356 SUNWhea
The last item listed (SUNWhea in this example) is the package you need.
=head3 Avoid /usr/ucb/cc.
You don't need to have /usr/ucb/ in your PATH to build perl. If you
want /usr/ucb/ in your PATH anyway, make sure that /usr/ucb/ is NOT
in your PATH before the directory containing the right C compiler.
=head3 Sun's C Compiler
If you use Sun's C compiler, make sure the correct directory
(usually /opt/SUNWspro/bin/) is in your PATH (before /usr/ucb/).
=head3 GCC
If you use gcc, make sure your installation is recent and complete.
perl versions since 5.6.0 build fine with gcc > 2.8.1 on Solaris >=
2.6.
You must Configure perl with
$ sh Configure -Dcc=gcc
If you don't, you may experience strange build errors.
If you have updated your Solaris version, you may also have to update
your gcc. For example, if you are running Solaris 2.6 and your gcc is
installed under /usr/local, check in /usr/local/lib/gcc-lib and make
sure you have the appropriate directory, sparc-sun-solaris2.6/ or
i386-pc-solaris2.6/. If gcc's directory is for a different version of
Solaris than you are running, then you will need to rebuild gcc for
your new version of Solaris.
You can get a precompiled version of gcc from
L<http://www.sunfreeware.com/> or L<http://www.blastwave.org/>. Make
sure you pick up the package for your Solaris release.
If you wish to use gcc to build add-on modules for use with the perl
shipped with Solaris, you should use the Solaris::PerlGcc module
which is available from CPAN. The perl shipped with Solaris
is configured and built with the Sun compilers, and the compiler
configuration information stored in Config.pm is therefore only
relevant to the Sun compilers. The Solaris:PerlGcc module contains a
replacement Config.pm that is correct for gcc - see the module for
details.
=head3 GNU as and GNU ld
The following information applies to gcc version 2. Volunteers to
update it as appropropriate for gcc version 3 would be appreciated.
The versions of as and ld supplied with Solaris work fine for building
perl. There is normally no need to install the GNU versions to
compile perl.
If you decide to ignore this advice and use the GNU versions anyway,
then be sure that they are relatively recent. Versions newer than 2.7
are apparently new enough. Older versions may have trouble with
dynamic loading.
If you wish to use GNU ld, then you need to pass it the -Wl,-E flag.
The hints/solaris_2.sh file tries to do this automatically by setting
the following Configure variables:
ccdlflags="$ccdlflags -Wl,-E"
lddlflags="$lddlflags -Wl,-E -G"
However, over the years, changes in gcc, GNU ld, and Solaris ld have made
it difficult to automatically detect which ld ultimately gets called.
You may have to manually edit config.sh and add the -Wl,-E flags
yourself, or else run Configure interactively and add the flags at the
appropriate prompts.
If your gcc is configured to use GNU as and ld but you want to use the
Solaris ones instead to build perl, then you'll need to add
-B/usr/ccs/bin/ to the gcc command line. One convenient way to do
that is with
$ sh Configure -Dcc='gcc -B/usr/ccs/bin/'
Note that the trailing slash is required. This will result in some
harmless warnings as Configure is run:
gcc: file path prefix `/usr/ccs/bin/' never used
These messages may safely be ignored.
(Note that for a SunOS4 system, you must use -B/bin/ instead.)
Alternatively, you can use the GCC_EXEC_PREFIX environment variable to
ensure that Sun's as and ld are used. Consult your gcc documentation
for further information on the -B option and the GCC_EXEC_PREFIX variable.
=head3 Sun and GNU make
The make under /usr/ccs/bin works fine for building perl. If you
have the Sun C compilers, you will also have a parallel version of
make (dmake). This works fine to build perl, but can sometimes cause
problems when running 'make test' due to underspecified dependencies
between the different test harness files. The same problem can also
affect the building of some add-on modules, so in those cases either
specify '-m serial' on the dmake command line, or use
/usr/ccs/bin/make instead. If you wish to use GNU make, be sure that
the set-group-id bit is not set. If it is, then arrange your PATH so
that /usr/ccs/bin/make is before GNU make or else have the system
administrator disable the set-group-id bit on GNU make.
=head3 Avoid libucb.
Solaris provides some BSD-compatibility functions in /usr/ucblib/libucb.a.
Perl will not build and run correctly if linked against -lucb since it
contains routines that are incompatible with the standard Solaris libc.
Normally this is not a problem since the solaris hints file prevents
Configure from even looking in /usr/ucblib for libraries, and also
explicitly omits -lucb.
=head2 Environment for Compiling perl on Solaris
=head3 PATH
Make sure your PATH includes the compiler (/opt/SUNWspro/bin/ if you're
using Sun's compiler) as well as /usr/ccs/bin/ to pick up the other
development tools (such as make, ar, as, and ld). Make sure your path
either doesn't include /usr/ucb or that it includes it after the
compiler and compiler tools and other standard Solaris directories.
You definitely don't want /usr/ucb/cc.
=head3 LD_LIBRARY_PATH
If you have the LD_LIBRARY_PATH environment variable set, be sure that
it does NOT include /lib or /usr/lib. If you will be building
extensions that call third-party shared libraries (e.g. Berkeley DB)
then make sure that your LD_LIBRARY_PATH environment variable includes
the directory with that library (e.g. /usr/local/lib).
If you get an error message
dlopen: stub interception failed
it is probably because your LD_LIBRARY_PATH environment variable
includes a directory which is a symlink to /usr/lib (such as /lib).
The reason this causes a problem is quite subtle. The file
libdl.so.1.0 actually *only* contains functions which generate 'stub
interception failed' errors! The runtime linker intercepts links to
"/usr/lib/libdl.so.1.0" and links in internal implementations of those
functions instead. [Thanks to Tim Bunce for this explanation.]
=head1 RUN CONFIGURE.
See the INSTALL file for general information regarding Configure.
Only Solaris-specific issues are discussed here. Usually, the
defaults should be fine.
=head2 64-bit perl on Solaris.
See the INSTALL file for general information regarding 64-bit compiles.
In general, the defaults should be fine for most people.
By default, perl-5.6.0 (or later) is compiled as a 32-bit application
with largefile and long-long support.
=head3 General 32-bit vs. 64-bit issues.
Solaris 7 and above will run in either 32 bit or 64 bit mode on SPARC
CPUs, via a reboot. You can build 64 bit apps whilst running 32 bit
mode and vice-versa. 32 bit apps will run under Solaris running in
either 32 or 64 bit mode. 64 bit apps require Solaris to be running
64 bit mode.
Existing 32 bit apps are properly known as LP32, i.e. Longs and
Pointers are 32 bit. 64-bit apps are more properly known as LP64.
The discriminating feature of a LP64 bit app is its ability to utilise a
64-bit address space. It is perfectly possible to have a LP32 bit app
that supports both 64-bit integers (long long) and largefiles (> 2GB),
and this is the default for perl-5.6.0.
For a more complete explanation of 64-bit issues, see the
"Solaris 64-bit Developer's Guide" at L<http://docs.sun.com/>
You can detect the OS mode using "isainfo -v", e.g.
$ isainfo -v # Ultra 30 in 64 bit mode
64-bit sparcv9 applications
32-bit sparc applications
By default, perl will be compiled as a 32-bit application. Unless
you want to allocate more than ~ 4GB of memory inside perl, or unless
you need more than 255 open file descriptors, you probably don't need
perl to be a 64-bit app.
=head3 Large File Support
For Solaris 2.6 and onwards, there are two different ways for 32-bit
applications to manipulate large files (files whose size is > 2GByte).
(A 64-bit application automatically has largefile support built in
by default.)
First is the "transitional compilation environment", described in
lfcompile64(5). According to the man page,
The transitional compilation environment exports all the
explicit 64-bit functions (xxx64()) and types in addition to
all the regular functions (xxx()) and types. Both xxx() and
xxx64() functions are available to the program source. A
32-bit application must use the xxx64() functions in order
to access large files. See the lf64(5) manual page for a
complete listing of the 64-bit transitional interfaces.
The transitional compilation environment is obtained with the
following compiler and linker flags:
getconf LFS64_CFLAGS -D_LARGEFILE64_SOURCE
getconf LFS64_LDFLAG # nothing special needed
getconf LFS64_LIBS # nothing special needed
Second is the "large file compilation environment", described in
lfcompile(5). According to the man page,
Each interface named xxx() that needs to access 64-bit entities
to access large files maps to a xxx64() call in the
resulting binary. All relevant data types are defined to be
of correct size (for example, off_t has a typedef definition
for a 64-bit entity).
An application compiled in this environment is able to use
the xxx() source interfaces to access both large and small
files, rather than having to explicitly utilize the transitional
xxx64() interface calls to access large files.
Two exceptions are fseek() and ftell(). 32-bit applications should
use fseeko(3C) and ftello(3C). These will get automatically mapped
to fseeko64() and ftello64().
The large file compilation environment is obtained with
getconf LFS_CFLAGS -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
getconf LFS_LDFLAGS # nothing special needed
getconf LFS_LIBS # nothing special needed
By default, perl uses the large file compilation environment and
relies on Solaris to do the underlying mapping of interfaces.
=head3 Building an LP64 perl
To compile a 64-bit application on an UltraSparc with a recent Sun Compiler,
you need to use the flag "-xarch=v9". getconf(1) will tell you this, e.g.
$ getconf -a | grep v9
XBS5_LP64_OFF64_CFLAGS: -xarch=v9
XBS5_LP64_OFF64_LDFLAGS: -xarch=v9
XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9
XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9
XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9
XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9
_XBS5_LP64_OFF64_CFLAGS: -xarch=v9
_XBS5_LP64_OFF64_LDFLAGS: -xarch=v9
_XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9
_XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9
_XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9
_XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9
This flag is supported in Sun WorkShop Compilers 5.0 and onwards
(now marketed under the name Forte) when used on Solaris 7 or later on
UltraSparc systems.
If you are using gcc, you would need to use -mcpu=v9 -m64 instead. This
option is not yet supported as of gcc 2.95.2; from install/SPECIFIC
in that release:
GCC version 2.95 is not able to compile code correctly for sparc64
targets. Users of the Linux kernel, at least, can use the sparc32
program to start up a new shell invocation with an environment that
causes configure to recognize (via uname -a) the system as sparc-*-*
instead.
All this should be handled automatically by the hints file, if
requested.
=head3 Long Doubles.
As of 5.8.1, long doubles are working if you use the Sun compilers
(needed for additional math routines not included in libm).
=head2 Threads in perl on Solaris.
It is possible to build a threaded version of perl on Solaris. The entire
perl thread implementation is still experimental, however, so beware.
=head2 Malloc Issues with perl on Solaris.
Starting from perl 5.7.1 perl uses the Solaris malloc, since the perl
malloc breaks when dealing with more than 2GB of memory, and the Solaris
malloc also seems to be faster.
If you for some reason (such as binary backward compatibility) really
need to use perl's malloc, you can rebuild perl from the sources
and Configure the build with
$ sh Configure -Dusemymalloc
You should not use perl's malloc if you are building with gcc. There
are reports of core dumps, especially in the PDL module. The problem
appears to go away under -DDEBUGGING, so it has been difficult to
track down. Sun's compiler appears to be okay with or without perl's
malloc. [XXX further investigation is needed here.]
=head1 MAKE PROBLEMS.
=over 4
=item Dynamic Loading Problems With GNU as and GNU ld
If you have problems with dynamic loading using gcc on SunOS or
Solaris, and you are using GNU as and GNU ld, see the section
L<"GNU as and GNU ld"> above.
=item ld.so.1: ./perl: fatal: relocation error:
If you get this message on SunOS or Solaris, and you're using gcc,
it's probably the GNU as or GNU ld problem in the previous item
L<"GNU as and GNU ld">.
=item dlopen: stub interception failed
The primary cause of the 'dlopen: stub interception failed' message is
that the LD_LIBRARY_PATH environment variable includes a directory
which is a symlink to /usr/lib (such as /lib). See
L<"LD_LIBRARY_PATH"> above.
=item #error "No DATAMODEL_NATIVE specified"
This is a common error when trying to build perl on Solaris 2.6 with a
gcc installation from Solaris 2.5 or 2.5.1. The Solaris header files
changed, so you need to update your gcc installation. You can either
rerun the fixincludes script from gcc or take the opportunity to
update your gcc installation.
=item sh: ar: not found
This is a message from your shell telling you that the command 'ar'
was not found. You need to check your PATH environment variable to
make sure that it includes the directory with the 'ar' command. This
is a common problem on Solaris, where 'ar' is in the /usr/ccs/bin/
directory.
=back
=head1 MAKE TEST
=head2 op/stat.t test 4 in Solaris
op/stat.t test 4 may fail if you are on a tmpfs of some sort.
Building in /tmp sometimes shows this behavior. The
test suite detects if you are building in /tmp, but it may not be able
to catch all tmpfs situations.
=head2 nss_delete core dump from op/pwent or op/grent
See L<perlhpux/"nss_delete core dump from op/pwent or op/grent">.
=head1 PREBUILT BINARIES OF PERL FOR SOLARIS.
You can pick up prebuilt binaries for Solaris from
L<http://www.sunfreeware.com/>, L<http://www.blastwave.org>,
ActiveState L<http://www.activestate.com/>, and
L<http://www.perl.com/> under the Binaries list at the top of the
page. There are probably other sources as well. Please note that
these sites are under the control of their respective owners, not the
perl developers.
=head1 RUNTIME ISSUES FOR PERL ON SOLARIS.
=head2 Limits on Numbers of Open Files on Solaris.
The stdio(3C) manpage notes that for LP32 applications, only 255
files may be opened using fopen(), and only file descriptors 0
through 255 can be used in a stream. Since perl calls open() and
then fdopen(3C) with the resulting file descriptor, perl is limited
to 255 simultaneous open files, even if sysopen() is used. If this
proves to be an insurmountable problem, you can compile perl as a
LP64 application, see L<Building an LP64 perl> for details. Note
also that the default resource limit for open file descriptors on
Solaris is 255, so you will have to modify your ulimit or rctl
(Solaris 9 onwards) appropriately.
=head1 SOLARIS-SPECIFIC MODULES.
See the modules under the Solaris:: and Sun::Solaris namespaces on CPAN,
see L<http://www.cpan.org/modules/by-module/Solaris/> and
L<http://www.cpan.org/modules/by-module/Sun/>.
=head1 SOLARIS-SPECIFIC PROBLEMS WITH MODULES.
=head2 Proc::ProcessTable on Solaris
Proc::ProcessTable does not compile on Solaris with perl5.6.0 and higher
if you have LARGEFILES defined. Since largefile support is the
default in 5.6.0 and later, you have to take special steps to use this
module.
The problem is that various structures visible via procfs use off_t,
and if you compile with largefile support these change from 32 bits to
64 bits. Thus what you get back from procfs doesn't match up with
the structures in perl, resulting in garbage. See proc(4) for further
discussion.
A fix for Proc::ProcessTable is to edit Makefile to
explicitly remove the largefile flags from the ones MakeMaker picks up
from Config.pm. This will result in Proc::ProcessTable being built
under the correct environment. Everything should then be OK as long as
Proc::ProcessTable doesn't try to share off_t's with the rest of perl,
or if it does they should be explicitly specified as off64_t.
=head2 BSD::Resource on Solaris
BSD::Resource versions earlier than 1.09 do not compile on Solaris
with perl 5.6.0 and higher, for the same reasons as Proc::ProcessTable.
BSD::Resource versions starting from 1.09 have a workaround for the problem.
=head2 Net::SSLeay on Solaris
Net::SSLeay requires a /dev/urandom to be present. This device is
available from Solaris 9 onwards. For earlier Solaris versions you
can either get the package SUNWski (packaged with several Sun
software products, for example the Sun WebServer, which is part of
the Solaris Server Intranet Extension, or the Sun Directory Services,
part of Solaris for ISPs) or download the ANDIrand package from
L<http://www.cosy.sbg.ac.at/~andi/>. If you use SUNWski, make a
symbolic link /dev/urandom pointing to /dev/random. For more details,
see Document ID27606 entitled "Differing /dev/random support requirements
within Solaris[TM] Operating Environments", available at
http://sunsolve.sun.com .
It may be possible to use the Entropy Gathering Daemon (written in
Perl!), available from L<http://www.lothar.com/tech/crypto/>.
=head1 SunOS 4.x
In SunOS 4.x you most probably want to use the SunOS ld, /usr/bin/ld,
since the more recent versions of GNU ld (like 2.13) do not seem to
work for building Perl anymore. When linking the extensions, the
GNU ld gets very unhappy and spews a lot of errors like this
... relocation truncated to fit: BASE13 ...
and dies. Therefore the SunOS 4.1 hints file explicitly sets the
ld to be /usr/bin/ld.
As of Perl 5.8.1 the dynamic loading of libraries (DynaLoader, XSLoader)
also seems to have become broken in in SunOS 4.x. Therefore the default
is to build Perl statically.
Running the test suite in SunOS 4.1 is a bit tricky since the
F<lib/Tie/File/t/09_gen_rs> test hangs (subtest #51, FWIW) for some
unknown reason. Just stop the test and kill that particular Perl
process.
There are various other failures, that as of SunOS 4.1.4 and gcc 3.2.2
look a lot like gcc bugs. Many of the failures happen in the Encode
tests, where for example when the test expects "0" you get "0"
which should after a little squinting look very odd indeed.
Another example is earlier in F<t/run/fresh_perl> where chr(0xff) is
expected but the test fails because the result is chr(0xff). Exactly.
This is the "make test" result from the said combination:
Failed 27 test scripts out of 745, 96.38% okay.
Running the C<harness> is painful because of the many failing
Unicode-related tests will output megabytes of failure messages,
but if one patiently waits, one gets these results:
Failed Test Stat Wstat Total Fail Failed List of Failed
-----------------------------------------------------------------------------
...
../ext/Encode/t/at-cn.t 4 1024 29 4 13.79% 14-17
../ext/Encode/t/at-tw.t 10 2560 17 10 58.82% 2 4 6 8 10 12
14-17
../ext/Encode/t/enc_data.t 29 7424 ?? ?? % ??
../ext/Encode/t/enc_eucjp.t 29 7424 ?? ?? % ??
../ext/Encode/t/enc_module.t 29 7424 ?? ?? % ??
../ext/Encode/t/encoding.t 29 7424 ?? ?? % ??
../ext/Encode/t/grow.t 12 3072 24 12 50.00% 2 4 6 8 10 12 14
16 18 20 22 24
Failed Test Stat Wstat Total Fail Failed List of Failed
------------------------------------------------------------------------------
../ext/Encode/t/guess.t 255 65280 29 40 137.93% 10-29
../ext/Encode/t/jperl.t 29 7424 15 30 200.00% 1-15
../ext/Encode/t/mime-header.t 2 512 10 2 20.00% 2-3
../ext/Encode/t/perlio.t 22 5632 38 22 57.89% 1-4 9-16 19-20
23-24 27-32
../ext/List/Util/t/shuffle.t 0 139 ?? ?? % ??
../ext/PerlIO/t/encoding.t 14 1 7.14% 11
../ext/PerlIO/t/fallback.t 9 2 22.22% 3 5
../ext/Socket/t/socketpair.t 0 2 45 70 155.56% 11-45
../lib/CPAN/t/vcmp.t 30 1 3.33% 25
../lib/Tie/File/t/09_gen_rs.t 0 15 ?? ?? % ??
../lib/Unicode/Collate/t/test.t 199 30 15.08% 7 26-27 71-75
81-88 95 101
103-104 106 108-
109 122 124 161
169-172
../lib/sort.t 0 139 119 26 21.85% 107-119
op/alarm.t 4 1 25.00% 4
op/utfhash.t 97 1 1.03% 31
run/fresh_perl.t 91 1 1.10% 32
uni/tr_7jis.t ?? ?? % ??
uni/tr_eucjp.t 29 7424 6 12 200.00% 1-6
uni/tr_sjis.t 29 7424 6 12 200.00% 1-6
56 tests and 467 subtests skipped.
Failed 27/811 test scripts, 96.67% okay. 1383/75399 subtests failed, 98.17% okay.
The alarm() test failure is caused by system() apparently blocking
alarm(). That is probably a libc bug, and given that SunOS 4.x
has been end-of-lifed years ago, don't hold your breath for a fix.
In addition to that, don't try anything too Unicode-y, especially
with Encode, and you should be fine in SunOS 4.x.
=head1 AUTHOR
The original was written by Andy Dougherty F<doughera at lafayette.edu>
drawing heavily on advice from Alan Burlison, Nick Ing-Simmons, Tim Bunce,
and many other Solaris users over the years.
Please report any errors, updates, or suggestions to F<perlbug at perl.org>.
--- NEW FILE: README.macosx ---
If you read this file _as_is_, just ignore the funny characters you see.
It is written in the POD format (see pod/perlpod.pod) which is specially
designed to be readable as is.
=head1 NAME
README.macosx - Perl under Mac OS X
=head1 SYNOPSIS
This document briefly describes perl under Mac OS X.
=head1 DESCRIPTION
The latest Perl release (5.8.8 as of this writing) builds without changes
under Mac OS X. Under 10.3 "Panther" and newer OS versions, all self-tests
pass, and all standard features are supported.
Earlier Mac OS X releases (10.2 "Jaguar" and older) did not include a
completely thread-safe libc, so threading is not fully supported. Also,
earlier releases included a buggy libdb, so some of the DB_File tests
are known to fail on those releases.
=head2 Installation Prefix
The default installation location for this release uses the traditional
UNIX directory layout under /usr/local. This is the recommended location
for most users, and will leave the Apple-supplied Perl and its modules
undisturbed.
Using an installation prefix of '/usr' will result in a directory layout
that mirrors that of Apple's default Perl, with core modules stored in
'/System/Library/Perl/${version}', CPAN modules stored in
'/Library/Perl/${version}', and the addition of
'/Network/Library/Perl/${version}' to @INC for modules that are stored
on a file server and used by many Macs.
=head2 SDK support
First, export the path to the SDK into the build environment:
export SDK=/Developer/SDKs/MacOSX10.3.9.sdk
Use an SDK by exporting some additions to Perl's 'ccflags' and '..flags'
config variables:
./Configure -Accflags="-nostdinc -B$SDK/usr/include/gcc \
-B$SDK/usr/lib/gcc -isystem$SDK/usr/include \
-F$SDK/System/Library/Frameworks" \
-Aldflags="-Wl,-syslibroot,$SDK" \
-de
=head2 Universal Binary support
To compile perl as a universal binary (built for both ppc and intel), export
the SDK variable as above, selecting the 10.4u SDK:
export SDK=/Developer/SDKs/MacOSX10.4u.sdk
In addition to the compiler flags used to select the SDK, also add the flags
for creating a universal binary:
./Configure -Accflags="-arch i686 -arch ppc -nostdinc -B$SDK/usr/include/gcc \
-B$SDK/usr/lib/gcc -isystem$SDK/usr/include \
-F$SDK/System/Library/Frameworks" \
-Aldflags="-arch i686 -arch ppc -Wl,-syslibroot,$SDK" \
-de
Keep in mind that these compiler and linker settings will also be used when
building CPAN modules. For XS modules to be compiled as a universal binary, any
libraries it links to must also be universal binaries. The system libraries that
Apple includes with the 10.4u SDK are all universal, but user-installed libraries
may need to be re-installed as universal binaries.
=head2 libperl and Prebinding
Mac OS X ships with a dynamically-loaded libperl, but the default for
this release is to compile a static libperl. The reason for this is
pre-binding. Dynamic libraries can be pre-bound to a specific address in
memory in order to decrease load time. To do this, one needs to be aware
of the location and size of all previously-loaded libraries. Apple
collects this information as part of their overall OS build process, and
thus has easy access to it when building Perl, but ordinary users would
need to go to a great deal of effort to obtain the information needed
for pre-binding.
You can override the default and build a shared libperl if you wish
(S<Configure ... -Duseshrlib>), but the load time on pre-10.4 OS
releases will be greater than either the static library, or Apple's
pre-bound dynamic library.
With 10.4 "Tiger" and newer, Apple has all but eliminated the performance
penalty for non-prebound libraries.
=head2 Updating Apple's Perl
In a word - don't, at least without a *very* good reason. Your scripts
can just as easily begin with "#!/usr/local/bin/perl" as with
"#!/usr/bin/perl". Scripts supplied by Apple and other third parties as
part of installation packages and such have generally only been tested
with the /usr/bin/perl that's installed by Apple.
If you find that you do need to update the system Perl, one issue worth
keeping in mind is the question of static vs. dynamic libraries. If you
upgrade using the default static libperl, you will find that the dynamic
libperl supplied by Apple will not be deleted. If both libraries are
present when an application that links against libperl is built, ld will
link against the dynamic library by default. So, if you need to replace
Apple's dynamic libperl with a static libperl, you need to be sure to
delete the older dynamic library after you've installed the update.
=head2 Known problems
If you have installed extra libraries such as GDBM through Fink
(in other words, you have libraries under F</sw/lib>), or libdlcompat
to F</usr/local/lib>, you may need to be extra careful when running
Configure to not to confuse Configure and Perl about which libraries
to use. Being confused will show up for example as "dyld" errors about
symbol problems, for example during "make test". The safest bet is to run
Configure as
Configure ... -Uloclibpth -Dlibpth=/usr/lib
to make Configure look only into the system libraries. If you have some
extra library directories that you really want to use (such as newer
Berkeley DB libraries in pre-Panther systems), add those to the libpth:
Configure ... -Uloclibpth -Dlibpth='/usr/lib /opt/lib'
The default of building Perl statically may cause problems with complex
applications like Tk: in that case consider building shared Perl
Configure ... -Duseshrplib
but remember that there's a startup cost to pay in that case (see above
"libperl and Prebinding").
Starting with Tiger (Mac OS X 10.4), Apple shipped broken locale files for
the eu_ES locale (Basque-Spain). In previous releases of Perl, this resulted in
failures in the C<lib/locale> test. These failures have been supressed
in the current release of Perl by making the test ignore the broken locale.
If you need to use the eu_ES locale, you should contact Apple support.
=head2 MacPerl
Quite a bit has been written about MacPerl, the Perl distribution for
"Classic MacOS" - that is, versions 9 and earlier of MacOS. Because it
runs in environment that's very different from that of UNIX, many things
are done differently in MacPerl. Modules are installed using a different
procedure, Perl itself is built differently, path names are different,
etc.
>From the perspective of a Perl programmer, Mac OS X is more like a
traditional UNIX than Classic MacOS. If you find documentation that
refers to a special procedure that's needed for MacOS that's drastically
different from the instructions provided for UNIX, the MacOS
instructions are quite often intended for MacPerl on Classic MacOS. In
that case, the correct procedure on Mac OS X is usually to follow the
UNIX instructions, rather than the MacPerl instructions.
=head2 Carbon
MacPerl ships with a number of modules that are used to access the
classic MacOS toolbox. Many of these modules have been updated to use
Mac OS X's newer "Carbon" toolbox, and are available from CPAN in the
"Mac::Carbon" module.
=head2 Cocoa
There are two ways to use Cocoa from Perl. Apple's PerlObjCBridge
module, included with Mac OS X, can be used by standalone scripts to
access Foundation (i.e. non-GUI) classes and objects.
An alternative is CamelBones, a framework that allows access to both
Foundation and AppKit classes and objects, so that full GUI applications
can be built in Perl. CamelBones can be found on SourceForge, at
L<http://www.sourceforge.net/projects/camelbones/>.
=head1 Starting From Scratch
Unfortunately it is not that difficult somehow manage to break one's
Mac OS X Perl rather severely. If all else fails and you want to
really, B<REALLY>, start from scratch and remove even your Apple Perl
installation (which has become corrupted somehow), the following
instructions should do it. B<Please think twice before following
these instructions: they are much like conducting brain surgery to
yourself. Without anesthesia.> We will B<not> come to fix your system
if you do this.
First, get rid of the libperl.dylib:
# cd /System/Library/Perl/darwin/CORE
# rm libperl.dylib
Then delete every .bundle file found anywhere in the folders:
/System/Library/Perl
/Library/Perl
You can find them for example by
# find /System/Library/Perl /Library/Perl -name '*.bundle' -print
After this you can either copy Perl from your operating system media
(you will need at least the /System/Library/Perl and /usr/bin/perl),
or rebuild Perl from the source code with C<Configure -Dprefix=/usr
-Dusershrplib> NOTE: the C<-Dprefix=/usr> to replace the system Perl
works much better with Perl 5.8.1 and later, in Perl 5.8.0 the
settings were not quite right.
"Pacifist" from CharlesSoft (L<http://www.charlessoft.com/>) is a nice
way to extract the Perl binaries from the OS media, without having to
reinstall the entire OS.
=head1 AUTHOR
This README was written by Sherm Pendley E<lt>sherm at dot-app.orgE<gt>,
and subsequently updated by Dominic Dunlop E<lt>domo at computer.orgE<gt>.
The "Starting From Scratch" recipe was contributed by John Montbriand
E<lt>montbriand at apple.comE<gt>.
=head1 DATE
Last modified 2005-11-07.
--- NEW FILE: deb.c ---
/* deb.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "Didst thou think that the eyes of the White Tower were blind? Nay, I
* have seen more than thou knowest, Gray Fool." --Denethor
*/
/*
* This file contains various utilities for producing debugging output
* (mainly related to displaying the stack)
*/
#include "EXTERN.h"
#define PERL_IN_DEB_C
#include "perl.h"
#if defined(PERL_IMPLICIT_CONTEXT)
void
Perl_deb_nocontext(const char *pat, ...)
{
#ifdef DEBUGGING
dTHX;
va_list args;
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
#endif /* DEBUGGING */
}
#endif
void
Perl_deb(pTHX_ const char *pat, ...)
{
#ifdef DEBUGGING
va_list args;
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
#endif /* DEBUGGING */
}
void
Perl_vdeb(pTHX_ const char *pat, va_list *args)
{
#ifdef DEBUGGING
char* file = OutCopFILE(PL_curcop);
#ifdef USE_5005THREADS
PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t",
PTR2UV(thr),
(file ? file : "<free>"),
(long)CopLINE(PL_curcop));
#else
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
(long)CopLINE(PL_curcop));
#endif /* USE_5005THREADS */
(void) PerlIO_vprintf(Perl_debug_log, pat, *args);
#endif /* DEBUGGING */
}
I32
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
(IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base),
(IV)(PL_stack_max-PL_stack_base));
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n",
PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)),
PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)),
PTR2UV(AvMAX(PL_curstack)));
#endif /* DEBUGGING */
return 0;
}
/* dump the contents of a particular stack
* Display stack_base[stack_min+1 .. stack_max],
* and display the marks whose offsets are contained in addresses
* PL_markstack[mark_min+1 .. mark_max] and whose values are in the range
* of the stack values being displayed
*
* Only displays top 30 max
*/
STATIC void
S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
register I32 i = stack_max - 30;
const I32 *markscan = PL_markstack + mark_min;
if (i < stack_min)
i = stack_min;
while (++markscan <= PL_markstack + mark_max)
if (*markscan >= i)
break;
if (i > stack_min)
PerlIO_printf(Perl_debug_log, "... ");
if (stack_base[0] != &PL_sv_undef || stack_max < 0)
PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
do {
++i;
if (markscan <= PL_markstack + mark_max && *markscan < i) {
do {
++markscan;
PerlIO_putc(Perl_debug_log, '*');
}
while (markscan <= PL_markstack + mark_max && *markscan < i);
PerlIO_printf(Perl_debug_log, " ");
}
if (i > stack_max)
break;
PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i]));
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
#endif /* DEBUGGING */
}
/* dump the current stack */
I32
Perl_debstack(pTHX)
{
#ifndef SKIP_DEBUGGING
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
PerlIO_printf(Perl_debug_log, " => ");
deb_stack_n(PL_stack_base,
0,
PL_stack_sp - PL_stack_base,
PL_curstackinfo->si_markoff,
PL_markstack_ptr - PL_markstack);
#endif /* SKIP_DEBUGGING */
return 0;
}
#ifdef DEBUGGING
static const char * si_names[] = {
"UNKNOWN",
"UNDEF",
"MAIN",
"MAGIC",
"SORT",
"SIGNAL",
"OVERLOAD",
"DESTROY",
"WARNHOOK",
"DIEHOOK",
"REQUIRE"
};
#endif
/* display all stacks */
void
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
I32 ix, si_ix;
PERL_SI *si;
/* rewind to start of chain */
si = PL_curstackinfo;
while (si->si_prev)
si = si->si_prev;
si_ix=0;
for (;;)
{
const int si_name_ix = si->si_type+1; /* -1 is a valid index */
const char *si_name = (si_name_ix>= sizeof(si_names)) ? "????" : si_names[si_name_ix];
PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n",
(IV)si_ix, si_name);
for (ix=0; ix<=si->si_cxix; ix++) {
const PERL_CONTEXT *cx = &(si->si_cxstack[ix]);
PerlIO_printf(Perl_debug_log,
" CX %"IVdf": %-6s => ",
(IV)ix, PL_block_type[CxTYPE(cx)]
);
/* substitution contexts don't save stack pointers etc) */
if (CxTYPE(cx) == CXt_SUBST)
PerlIO_printf(Perl_debug_log, "\n");
else {
/* Find the the current context's stack range by searching
* forward for any higher contexts using this stack; failing
* that, it will be equal to the size of the stack for old
* stacks, or PL_stack_sp for the current stack
*/
I32 i, stack_min, stack_max, mark_min, mark_max;
I32 ret_min, ret_max;
PERL_CONTEXT *cx_n;
PERL_SI *si_n;
cx_n = Null(PERL_CONTEXT*);
/* there's a separate stack per SI, so only search
* this one */
for (i=ix+1; i<=si->si_cxix; i++) {
if (CxTYPE(cx) == CXt_SUBST)
continue;
cx_n = &(si->si_cxstack[i]);
break;
}
stack_min = cx->blk_oldsp;
if (cx_n) {
stack_max = cx_n->blk_oldsp;
}
else if (si == PL_curstackinfo) {
stack_max = PL_stack_sp - AvARRAY(si->si_stack);
}
else {
stack_max = AvFILLp(si->si_stack);
}
/* for the other stack types, there's only one stack
* shared between all SIs */
si_n = si;
i = ix;
cx_n = Null(PERL_CONTEXT*);
for (;;) {
i++;
if (i > si_n->si_cxix) {
if (si_n == PL_curstackinfo)
break;
else {
si_n = si_n->si_next;
i = 0;
}
}
if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST)
continue;
cx_n = &(si_n->si_cxstack[i]);
break;
}
mark_min = cx->blk_oldmarksp;
ret_min = cx->blk_oldretsp;
if (cx_n) {
mark_max = cx_n->blk_oldmarksp;
ret_max = cx_n->blk_oldretsp;
}
else {
mark_max = PL_markstack_ptr - PL_markstack;
ret_max = PL_retstack_ix;
}
deb_stack_n(AvARRAY(si->si_stack),
stack_min, stack_max, mark_min, mark_max);
if (ret_max > ret_min) {
PerlIO_printf(Perl_debug_log, " retop=%s\n",
PL_retstack[ret_min]
? OP_NAME(PL_retstack[ret_min])
: "(null)"
);
}
}
} /* next context */
if (si == PL_curstackinfo)
break;
si = si->si_next;
si_ix++;
if (!si)
break; /* shouldn't happen, but just in case.. */
} /* next stackinfo */
PerlIO_printf(Perl_debug_log, "\n");
#endif /* DEBUGGING */
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
--- NEW FILE: miniperlmain.c ---
/* miniperlmain.c
*
* Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
* 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "The Road goes ever on and on, down from the door where it began."
*/
/* This file contains the main() function for the perl interpreter.
* Note that miniperlmain.c contains main() for the 'miniperl' binary,
* while perlmain.c contains main() for the 'perl' binary.
*
* Miniperl is like perl except that it does not support dynamic loading,
* and in fact is used to build the dynamic modules needed for the 'real'
* perl executable.
*/
#ifdef OEMVS
#ifdef MYMALLOC
/* sbrk is limited to first heap segment so make it big */
#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
#else
#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
#endif
#endif
#include "EXTERN.h"
#define PERL_IN_MINIPERLMAIN_C
#include "perl.h"
static void xs_init (pTHX);
static PerlInterpreter *my_perl;
#if defined (__MINT__) || defined (atarist)
/* The Atari operating system doesn't have a dynamic stack. The
stack size is determined from this value. */
long _stksize = 64 * 1024;
#endif
int
main(int argc, char **argv, char **env)
{
int exitstatus;
(void)env;
#ifndef PERL_USE_SAFE_PUTENV
PL_use_safe_putenv = 0;
#endif /* PERL_USE_SAFE_PUTENV */
#ifdef PERL_GLOBAL_STRUCT
#define PERLVAR(var,type) /**/
#define PERLVARA(var,type) /**/
#define PERLVARI(var,type,init) PL_Vars.var = init;
#define PERLVARIC(var,type,init) PL_Vars.var = init;
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#endif
/* if user wants control of gprof profiling off by default */
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
PERL_SYS_INIT3(&argc,&argv,&env);
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
/* XXX Ideally, this should really be happening in perl_alloc() or
* perl_construct() to keep libperl.a transparently fork()-safe.
* It is currently done here only because Apache/mod_perl have
* problems due to lack of a call to cancel pthread_atfork()
* handlers when shared objects that contain the handlers may
* be dlclose()d. This forces applications that embed perl to
* call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
* been called at least once before in the current process.
* --GSAR 2001-07-20 */
PTHREAD_ATFORK(Perl_atfork_lock,
Perl_atfork_unlock,
Perl_atfork_unlock);
#endif
if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct(my_perl);
PL_perl_destruct_level = 0;
}
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
if (!exitstatus)
perl_run(my_perl);
exitstatus = perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(exitstatus);
return exitstatus;
}
/* Register any extra external extensions */
/* Do not delete this line--writemain depends on it */
static void
xs_init(pTHX)
{
dXSUB_SYS;
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: t
* End:
*
* ex: set ts=8 sts=4 sw=4 noet:
*/
More information about the dslinux-commit
mailing list