gerti Gerd Knops gerti@BITart.com
gibreel Stephen Zander gibreel@pobox.com
gnat Nathan Torkington gnat@frii.com
-gsar Gurusamy Sarathy gsar@umich.edu
+gsar Gurusamy Sarathy gsar@activestate.com
hansmu Hans Mulder hansmu@xs4all.nl
ilya Ilya Zakharevich ilya@math.ohio-state.edu
jbuehler Joe Buehler jbuehler@hekimian.com
pudge Chris Nandor pudge@pobox.com
pueschel Norbert Pueschel pueschel@imsdd.meb.uni-bonn.de
pvhp Peter Prymmer pvhp@forte.com
-raphael Raphael Manfredi Raphael_Manfredi@grenoble.hp.com
+raphael Raphael Manfredi Raphael_Manfredi@pobox.com
rdieter Rex Dieter rdieter@math.unl.edu
rsanders Robert Sanders Robert.Sanders@linux.org
roberto Ollivier Robert roberto@keltia.freenix.fr
Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Tim Bunce <Tim.Bunce@ig.co.uk>
Andy Dougherty <doughera@lafcol.lafayette.edu>
- Gurusamy Sarathy <gsar@umich.edu>
+ Gurusamy Sarathy <gsar@activestate.com>
Chip Salzenberg <chip@perl.com>
And, of course, the Author of Perl:
----------------
-Version 5.005_62 Development release working toward 5.006
+Version 5.005_63 Development release working toward 5.6
----------------
____________________________________________________________________________
+[ 4676] By: gsar on 1999/12/09 10:51:43
+ Log: fix File::Find testsuite bugs in symlink-less places
+ Branch: perl
+ ! t/lib/filefind.t
+____________________________________________________________________________
+[ 4675] By: gsar on 1999/12/09 10:22:31
+ Log: USE_ITHREADS tweaks and notes
+ Branch: perl
+ ! op.c pod/perldelta.pod sv.c
+____________________________________________________________________________
+[ 4674] By: gsar on 1999/12/09 10:21:53
+ Log: allow new style sort subs to work under usethreads
+ Branch: perl
+ ! pp_ctl.c
+____________________________________________________________________________
+[ 4673] By: gsar on 1999/12/09 04:00:23
+ Log: document compatibility issue with literal list slices and NOTOP
+ (C<not (1,2,3)[0]> is now a syntax error)
+ Branch: perl
+ ! pod/perldelta.pod
+____________________________________________________________________________
+[ 4672] By: gsar on 1999/12/09 01:14:46
+ Log: avoid mismatched expectation <-> int types for C++ builds
+ Branch: perl
+ ! embed.pl intrpvar.h proto.h toke.c
+____________________________________________________________________________
+[ 4671] By: gsar on 1999/12/09 00:36:24
+ Log: newer version of File::Find with support for following symlinks and
+ other features, from Helmut Jarausch <jarausch@igpm.rwth-aachen.de>
+ Branch: perl
+ ! lib/File/Find.pm pod/perldelta.pod t/lib/filefind.t
+____________________________________________________________________________
+[ 4670] By: gsar on 1999/12/09 00:13:06
+ Log: avoid initializing GvCV slot for autovivified filehandles
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 4669] By: gsar on 1999/12/08 19:09:27
+ Log: apply change#4618 again along with Ilya's patch to fix bugs
+ in it (see change#4622)
+ Branch: perl
+ ! embed.h embed.pl perl.h proto.h regcomp.c regcomp.h regexec.c
+ ! t/op/re_tests t/op/subst.t
+____________________________________________________________________________
+[ 4668] By: gsar on 1999/12/08 18:56:53
+ Log: patch to fix parser bug in C<${h{${a[0]}}} = 13>
+ From: Larry Wall <larry@wall.org>
+ Date: Tue, 7 Dec 1999 12:39:30 -0800 (PST)
+ Message-Id: <199912072039.MAA13257@kiev.wall.org>
+ Subject: Re: [ID 19991204.002] Inconsistency of ${hash{key}}
+ Branch: perl
+ ! embedvar.h intrpvar.h objXSUB.h sv.c toke.c
+____________________________________________________________________________
+[ 4667] By: gsar on 1999/12/08 18:47:37
+ Log: patch to fix aix hints from ortmann@vnet.ibm.com
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 4666] By: gsar on 1999/12/08 18:29:02
+ Log: documentation tweaks from M. J. T. Guy, Micheal Schwern, and
+ Tim Meadowcroft
+ Branch: perl
+ ! Changes lib/Benchmark.pm pod/perlipc.pod pod/perlre.pod
+____________________________________________________________________________
+[ 4665] By: gsar on 1999/12/08 02:22:31
+ Log: introduce save_I8() for saving byte values
+ Branch: perl
+ ! embed.h embed.pl global.sym objXSUB.h perlapi.c proto.h
+ ! regcomp.c regexec.c scope.c scope.h sv.c
+____________________________________________________________________________
+[ 4664] By: gsar on 1999/12/08 02:02:33
+ Log: use SAVEINT() rather than SAVEDESTRUCTOR() for saving PL_expect etc.
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 4663] By: gsar on 1999/12/08 01:11:44
+ Log: longstanding typo in lexer: PL_lex_expect was not properly
+ saved on reentry
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 4662] By: gsar on 1999/12/07 23:16:21
+ Log: typos in change#4546
+ Branch: perl
+ ! ext/B/B.xs ext/B/B/Bytecode.pm ext/B/B/C.pm sv.c
+____________________________________________________________________________
+[ 4661] By: gsar on 1999/12/07 09:33:50
+ Log: typos in change#4660
+ Branch: perl
+ ! embed.h embed.pl objXSUB.h perl.h perlapi.c pp_sys.c proto.h
+____________________________________________________________________________
+[ 4660] By: gsar on 1999/12/06 23:42:55
+ Log: tweaks for building with -DUSE_ITHREADS on !WIN32 platforms;
+ fix bug where lc($readonly) could result in bogus errors
+ Branch: perl
+ ! embed.h embed.pl iperlsys.h makedef.pl objXSUB.h perlapi.c
+ ! pp.c pp_sys.c proto.h sv.c
+____________________________________________________________________________
+[ 4659] By: gsar on 1999/12/06 15:24:31
+ Log: allow IRIX 6.5 to build perl (from Helmut Jarausch
+ <jarausch@igpm.rwth-aachen.de>)
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 4658] By: gsar on 1999/12/06 15:18:30
+ Log: fix for -Dp via $^D (suggested by Stephane Payrard
+ <stef@adnaccess.com>)
+ Branch: perl
+ ! mg.c
+____________________________________________________________________________
+[ 4657] By: gsar on 1999/12/06 06:50:01
+ Log: change#4641 needs perldiag.pod edit
+ Branch: perl
+ - lib/unicode/UnicodeData-Latest.txt
+ ! pod/perldiag.pod
+____________________________________________________________________________
+[ 4656] By: gsar on 1999/12/06 01:36:56
+ Log: Makefile tweak for change#4649
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 4655] By: gsar on 1999/12/05 17:23:57
+ Log: change#4653 was missing a patch reject
+ Branch: perl
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 4654] By: gsar on 1999/12/05 11:41:04
+ Log: windows build tweaks for Borland compiler
+ Branch: perl
+ ! win32/makefile.mk win32/perlhost.h win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 4653] By: gsar on 1999/12/05 11:07:37
+ Log: applied somewhat modified version of suggested patch
+ From: "Benjamin Stuhl" <sho_pi@hotmail.com>
+ Date: Thu, 18 Nov 1999 18:45:27 PST
+ Message-ID: <19991119024527.72749.qmail@hotmail.com>
+ Subject: [PATCH 5.005_62] Perl on Win95, Mark IIB
+ Branch: perl
+ + win32/PerlCRT.def win32/gstartup.c win32/oldnames.def
+ ! MANIFEST ext/SDBM_File/Makefile.PL lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MM_Win32.pm win32/config_sh.PL win32/genmk95.pl
+ ! win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 4652] By: gsar on 1999/12/05 09:24:45
+ Log: From: Mike Hopkirk (hops) <hops@scoot.pdev.sco.com>
+ Date: Thu, 4 Nov 1999 16:34:23 -0800 (PST)
+ Message-Id: <199911050034.QAA06499@scoot.pdev.sco.com>
+ Subject: [ID 19991104.005] modified hints file for UnixWare7 ( svr5)
+ Branch: perl
+ ! Changes hints/svr5.sh
+____________________________________________________________________________
+[ 4651] By: gsar on 1999/12/05 09:01:19
+ Log: on dosish platforms, avoid infinite recursion in File::Path::mkpath()
+ when given non-existent drive names
+ Branch: perl
+ ! lib/File/Path.pm
+____________________________________________________________________________
+[ 4650] By: gsar on 1999/12/05 08:47:11
+ Log: windows build tweaks for change#4649
+ Branch: perl
+ ! win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 4649] By: gsar on 1999/12/05 07:49:28
+ Log: make File::Glob::glob() the default for CORE::glob()
+ (old csh glob can still be had with -DPERL_EXTERNAL_GLOB)
+ Branch: perl
+ ! Makefile.SH op.c pod/perldelta.pod win32/Makefile
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 4648] By: gsar on 1999/12/05 00:33:34
+ Log: fix bug in processing L<> tags (from j.vavruska@post.cz)
+ Branch: perl
+ ! lib/Pod/Html.pm
+____________________________________________________________________________
+[ 4647] By: gsar on 1999/12/05 00:14:01
+ Log: remove outdated entry
+ Branch: perl
+ ! pod/perltrap.pod
+____________________________________________________________________________
+[ 4646] By: gsar on 1999/12/04 22:48:51
+ Log: s/block/loop block/ in diagnostics about next, last, redo
+ Branch: perl
+ ! pod/perldiag.pod pp_ctl.c t/op/runlevel.t t/pragma/warn/pp_ctl
+____________________________________________________________________________
+[ 4645] By: gsar on 1999/12/04 22:25:32
+ Log: readability tweak suggested by GRommel@sears.com
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 4644] By: gsar on 1999/12/04 22:05:00
+ Log: Configure tweak from Peter Prymmer
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 4643] By: gsar on 1999/12/04 21:55:27
+ Log: make weak keyword check look for defined(&lock), not
+ merely defined(*lock)
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 4642] By: gsar on 1999/12/04 21:11:51
+ Log: make eof() open ARGV if it isn't open already; also fixes bug
+ where eof() would operate on any last-read filehandle, not
+ just ARGV
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 4641] By: gsar on 1999/12/04 04:42:25
+ Log: make uninitialized value warnings report opcode
+ Branch: perl
+ ! doio.c embed.h embed.pl global.sym objXSUB.h opcode.h
+ ! opcode.pl perl.h perlapi.c pp.c pp_hot.c proto.h sv.c
+ ! t/op/misc.t t/pragma/warn/1global t/pragma/warn/2use
+ ! t/pragma/warn/3both t/pragma/warn/4lint t/pragma/warn/7fatal
+ ! t/pragma/warn/doio t/pragma/warn/pp t/pragma/warn/pp_hot
+ ! t/pragma/warn/sv
+____________________________________________________________________________
+[ 4640] By: gsar on 1999/12/04 02:40:44
+ Log: provide explicit functions timegm_nocheck() and timelocal_nocheck()
+ that don't do range checking
+ Branch: perl
+ ! lib/Time/Local.pm
+____________________________________________________________________________
+[ 4639] By: gsar on 1999/12/04 01:00:49
+ Log: better implementation of change#3326; open(local $foo,...) now
+ allowed in addition to any uninitialized variable, for consistency
+ with how autovivification works elsewhere; add code to use the
+ variable name as the name of the handle for simple variables, so
+ that diagnostics report the handle: "... at - line 1, <$foo> line 10."
+ Branch: perl
+ ! op.c pod/perldelta.pod pp.c t/io/open.t
+____________________________________________________________________________
+[ 4638] By: gsar on 1999/12/03 21:20:00
+ Log: pod nits
+ Branch: perl
+ ! pod/perlfunc.pod pod/perlrun.pod
+____________________________________________________________________________
+[ 4637] By: gsar on 1999/12/03 08:59:04
+ Log: change#4431 was flawed
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 4636] By: gsar on 1999/12/03 07:59:52
+ Log: pod embellishments from Nathan Torkington
+ Branch: perl
+ ! pod/perlfaq2.pod pod/perlhack.pod
+____________________________________________________________________________
+[ 4635] By: gsar on 1999/12/03 07:56:04
+ Log: perlfaq4 typo (from Jeff Pinyan <jeffp@crusoe.net>)
+ Branch: perl
+ ! pod/perlfaq4.pod
+____________________________________________________________________________
+[ 4634] By: gsar on 1999/12/03 07:47:47
+ Log: test tweak for VMS (from Craig A. Berry)
+ Branch: perl
+ ! t/io/nargv.t
+____________________________________________________________________________
+[ 4633] By: gsar on 1999/12/03 07:44:52
+ Log: patchls tweak from Andreas Koenig
+ Branch: perl
+ ! Porting/patchls
+____________________________________________________________________________
+[ 4632] By: gsar on 1999/12/03 07:42:23
+ Log: don't mess with the umask()
+ Branch: perl
+ ! installhtml installman installperl lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/Manifest.pm
+____________________________________________________________________________
+[ 4631] By: gsar on 1999/12/03 06:52:50
+ Log: support -a switch to append bytecode to an existing file and make
+ perlcc use it (from Tom Hughes <tom@compton.nu>)
+ Branch: perl
+ ! ext/B/B/Bytecode.pm utils/perlcc.PL
+____________________________________________________________________________
+[ 4630] By: gsar on 1999/12/03 06:46:16
+ Log: document incompatible perl4 vec() vs bitwise ops interaction trap
+ (from Tom Phoenix)
+ Branch: perl
+ ! pod/perltrap.pod
+____________________________________________________________________________
+[ 4629] By: gsar on 1999/12/03 06:40:15
+ Log: use PerlIO abstraction rather than straight stdio (from
+ Chip Salzenberg)
+ Branch: perl
+ ! ext/ByteLoader/ByteLoader.xs
+____________________________________________________________________________
+[ 4628] By: gsar on 1999/12/03 06:15:54
+ Log: avoid warning in IO::Select::exists() if socket doesn't exist
+ Branch: perl
+ ! ext/IO/lib/IO/Select.pm
+____________________________________________________________________________
+[ 4627] By: gsar on 1999/12/03 06:05:19
+ Log: two small patches from Peter Prymmer <pvhp@forte.com>
+ Branch: perl
+ ! makedepend.SH win32/Makefile win32/makefile.mk
+____________________________________________________________________________
+[ 4626] By: gsar on 1999/12/03 05:36:38
+ Log: From: Peter Prymmer <pvhp@forte.com>
+ Date: Thu, 25 Nov 1999 21:06:19 -0800 (PST)
+ Message-Id: <199911260506.VAA17230@brio.forte.com>
+ Subject: [PATCH: 5.005_62] implement /[:ascii:]/ on ebcdic machines
+ Branch: perl
+ ! regcomp.c
+____________________________________________________________________________
+[ 4625] By: gsar on 1999/12/03 05:20:21
+ Log: Windows build tweaks due to change#4623
+ Branch: perl
+ ! win32/Makefile win32/makefile.mk win32/perlhost.h
+____________________________________________________________________________
+[ 4624] By: gsar on 1999/12/03 04:58:30
+ Log: add missing file
+ Branch: perl
+ + ext/DynaLoader/XSLoader_pm.PL
+____________________________________________________________________________
+[ 4623] By: gsar on 1999/12/03 04:47:03
+ Log: applied suggested patch; removed $VERSION = $VERSION hack
+ (change#4043 fixed the need for that)
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 16 Nov 1999 01:50:31 EST
+ Message-Id: <199911160650.BAA18874@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_62] XSLoader.pm
+ Branch: perl
+ ! MANIFEST ext/B/B.pm ext/ByteLoader/ByteLoader.pm
+ ! ext/DB_File/DB_File.pm ext/Data/Dumper/Dumper.pm
+ ! ext/Devel/DProf/DProf.pm ext/Devel/Peek/Peek.pm
+ ! ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/Makefile.PL
+ ! ext/DynaLoader/dlutils.c ext/Fcntl/Fcntl.pm
+ ! ext/File/Glob/Glob.pm ext/GDBM_File/GDBM_File.pm ext/IO/IO.pm
+ ! ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm
+ ! ext/Opcode/Opcode.pm ext/POSIX/POSIX.pm
+ ! ext/SDBM_File/SDBM_File.pm ext/Socket/Socket.pm
+ ! ext/Thread/Thread.pm ext/attrs/attrs.pm ext/re/re.pm
+ ! lib/AutoLoader.pm lib/FindBin.pm lib/Getopt/Std.pm
+____________________________________________________________________________
+[ 4622] By: gsar on 1999/12/03 04:02:39
+ Log: revert change#4618 (breaks C<$_ = 'A:B'; s/^[a-z]:/x/>)
+ Branch: perl
+ ! Changes embed.h embed.pl perl.h proto.h regcomp.c regcomp.h
+____________________________________________________________________________
+[ 4621] By: gsar on 1999/12/02 22:24:53
+ Log: caveat about thread-safety of extensions
+ Branch: perl
+ ! pod/perlfork.pod
+____________________________________________________________________________
+[ 4620] By: gsar on 1999/12/02 20:31:02
+ Log: XS documentation patches suggested by Ilya, severally adjusted
+ Branch: perl
+ ! pod/perlxs.pod pod/perlxstut.pod
+____________________________________________________________________________
+[ 4619] By: gsar on 1999/12/02 17:52:50
+ Log: re-add missing Unicode database master
+ Branch: perl
+ + lib/unicode/Unicode.300
+____________________________________________________________________________
+[ 4618] By: gsar on 1999/12/02 06:56:18
+ Log: applied suggested patch with prototype changes
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 23 Nov 1999 22:55:55 EST
+ Message-Id: <199911240355.WAA23033@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_62] First char cognizance
+ Branch: perl
+ ! embed.h embed.pl perl.h proto.h regcomp.c regcomp.h
+____________________________________________________________________________
+[ 4617] By: gsar on 1999/12/02 06:04:57
+ Log: fixes for bugs in change#4586 and OS/2 pod tweak, from Ilya
+ Branch: perl
+ ! os2/OS2/REXX/REXX.pm regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 4616] By: gsar on 1999/12/02 04:30:22
+ Log: various documentation tweaks suggested by M. J. T. Guy
+ Branch: perl
+ ! INSTALL lib/strict.pm pod/perlfunc.pod pod/perlsyn.pod
+____________________________________________________________________________
+[ 4615] By: gsar on 1999/12/02 04:17:43
+ Log: various File::Glob fixes for DOSISH platforms
+ From: "Moore, Paul" <Paul.Moore@uk.origin-it.com>
+ Date: Tue, 02 Nov 1999 11:11:25 GMT
+ Message-Id: <714DFA46B9BBD0119CD000805FC1F53BDC38E3@UKRUX002.rundc.uk.origin-it.com>
+ Subject: File::Glob again. Final patch, honest!
+ Branch: perl
+ + t/lib/glob-case.t
+ ! MANIFEST ext/File/Glob/Changes ext/File/Glob/Glob.pm
+ ! ext/File/Glob/Glob.xs ext/File/Glob/bsd_glob.c
+ ! ext/File/Glob/bsd_glob.h op.c t/lib/glob-global.t
+____________________________________________________________________________
+[ 4614] By: gsar on 1999/12/02 03:42:55
+ Log: allow XSUBs and prototyped subroutines to be used with sort() (tweaked
+ variant of patch suggested by Peter Haworth <pmh@edison.ioppublishing.com>)
+ Branch: perl
+ ! pod/perldelta.pod pod/perlfunc.pod pp_ctl.c t/op/sort.t
+____________________________________________________________________________
+[ 4613] By: gsar on 1999/12/02 01:59:19
+ Log: ignore yet another known scalar leak
+ Branch: perl
+ ! t/pragma/warn/regcomp
+____________________________________________________________________________
+[ 4612] By: gsar on 1999/12/02 01:15:02
+ Log: avoid potential stack extension bug in pp_unpack() (spotted by Ilya)
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 4611] By: gsar on 1999/12/02 00:31:43
+ Log: a somewhat tweaked version of suggested patch
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 27 Oct 1999 18:57:41 -0400 (EDT)
+ Message-Id: <199910272257.SAA29928@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_62] Another round of pack/vec docs patches
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4610] By: gsar on 1999/12/01 19:09:31
+ Log: more accurate require() pseudocode (from James P. Williams
+ <James.P.Williams@USAHQ.UnitedSpaceAlliance.com>)
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4609] By: gsar on 1999/12/01 18:43:49
+ Log: avoid "Callback called exit" error on intentional exit()
+ Branch: perl
+ ! embedvar.h intrpvar.h objXSUB.h perl.c perl.h pp_ctl.c
+____________________________________________________________________________
+[ 4608] By: gsar on 1999/12/01 18:42:38
+ Log: find_byclass() prototype was incoherent
+ Branch: perl
+ ! regexec.c
+____________________________________________________________________________
+[ 4607] By: gsar on 1999/12/01 05:45:10
+ Log: better documentation for goto &NAME (from M. J. T. Guy)
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4606] By: gsar on 1999/12/01 05:33:14
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ +> lib/unicode/Jamo.txt lib/unicode/NamesList.html
+ +> lib/unicode/UCD300.html lib/unicode/Unicode3.html
+ - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html
+ ! Changes
+ !> (integrate 210 files)
+____________________________________________________________________________
+[ 4605] By: gsar on 1999/12/01 05:15:27
+ Log: avoid PTR->IV cast warnings
+ Branch: perl
+ ! mg.c op.c scope.h
+____________________________________________________________________________
+[ 4604] By: gsar on 1999/12/01 03:59:56
+ Log: email address changes
+ Branch: perl
+ ! AUTHORS Changes Porting/genlog Porting/p4d2p Porting/p4desc
+ ! README.win32 ext/Data/Dumper/Dumper.pm lib/DB.pm
+ ! lib/File/DosGlob.pm lib/Math/Complex.pm lib/Math/Trig.pm
+ ! pod/perl5005delta.pod pod/perlport.pod t/op/runlevel.t
+ ! utils/perlbug.PL utils/perldoc.PL win32/bin/perlglob.pl
+____________________________________________________________________________
+[ 4603] By: gsar on 1999/12/01 03:45:13
+ Log: minor USE_ITHREADS tweaks
+ Branch: perl
+ ! doio.c op.c op.h pp_hot.c pp_sys.c run.c win32/Makefile
+ ! win32/perllib.c win32/win32.h
+____________________________________________________________________________
+[ 4602] By: gsar on 1999/12/01 01:00:09
+ Log: more complete pseudo-fork() support for Windows
+ Branch: perl
+ + pod/perlfork.pod win32/perlhost.h win32/vdir.h win32/vmem.h
+ ! MANIFEST XSUB.h cop.h dump.c embed.h embed.pl embedvar.h
+ ! ext/B/B/CC.pm ext/Opcode/Opcode.xs global.sym globals.c
+ ! globvar.sym gv.c hv.c intrpvar.h iperlsys.h makedef.pl mg.c
+ ! mpeix/mpeixish.h objXSUB.h op.c op.h os2/os2ish.h perl.c
+ ! perl.h perlapi.c plan9/plan9ish.h pod/Makefile pod/buildtoc
+ ! pod/perl.pod pod/roffitall pp.c pp_ctl.c pp_hot.c pp_sys.c
+ ! proto.h regcomp.c run.c scope.c scope.h sv.c t/op/fork.t
+ ! toke.c unixish.h util.c vos/vosish.h win32/Makefile
+ ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h
+ ! win32/win32iop.h win32/win32thread.h
+____________________________________________________________________________
+[ 4601] By: gsar on 1999/12/01 00:45:38
+ Log: rudimentary support for remote debugging, from aeons ago (somewhat
+ modified)
+ From: Graham TerMarsch <grahamt@ActiveState.com>
+ Date: Sat, 12 Sep 1998 10:46:55 -0700
+ Message-ID: <35FAB38F.EA9AAC50@activestate.com>
+ Subject: Re: Patches to perl5db.pl to allow for remote debugging
+ Branch: perl
+ ! lib/perl5db.pl
+____________________________________________________________________________
+[ 4600] By: chip on 1999/11/19 21:16:00
+ Log: Document known limitations of fdopen() on some systems,
+ as they apply to open() and sysopen().
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4599] By: chip on 1999/11/19 17:20:19
+ Log: Undef printf before redirecting it to PerlIO_stdoutf.
+ (Avoids an irritating warning when compiling with PerlIO.)
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 4598] By: jhi on 1999/11/22 21:30:17
+ Log: Small VMS nits from Craig A. Berry, <craig.berry@metamor.com>.
+ Branch: cfgperl
+ ! README.vms t/io/open.t
+____________________________________________________________________________
+[ 4597] By: jhi on 1999/11/21 16:21:21
+ Log: Replace #4596 with the change done in 5.005_03.
+ Branch: cfgperl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 4596] By: jhi on 1999/11/21 16:07:20
+ Log: Skip processing a file if the file to be opened is '-'
+ (can happen in UNICOS)
+ Branch: cfgperl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 4595] By: jhi on 1999/11/21 14:05:10
+ Log: VMS patches from Peter Prymmer.
+ Branch: cfgperl
+ ! doio.c mg.c taint.c vms/subconfigure.com vms/vms.c
+____________________________________________________________________________
+[ 4594] By: jhi on 1999/11/18 17:07:14
+ Log: The find_byclass prototype is already in proto.h.
+ Branch: cfgperl
+ ! regexec.c
+____________________________________________________________________________
+[ 4593] By: gsar on 1999/11/16 21:25:21
+ Log: typo in flag checks
+ Branch: utfperl
+ ! sv.h
+____________________________________________________________________________
+[ 4592] By: jhi on 1999/11/16 21:17:25
+ Log: Regen Configure.
+ Branch: cfgperl
+ ! Configure config_h.SH pp.c pp.h vms/subconfigure.com
+ Branch: metaconfig
+ ! U/a_dvisory/quadtype.U
+____________________________________________________________________________
+[ 4591] By: jhi on 1999/11/16 14:53:19
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> cop.h deb.c embed.h embed.pl global.sym lib/Pod/Checker.pm
+ !> lib/Pod/InputObjects.pm lib/Pod/Parser.pm lib/Pod/Select.pm
+ !> lib/Pod/Usage.pm makedef.pl objXSUB.h perl.c perlapi.c
+ !> pod/podchecker.PL pp_sys.c proto.h sv.c t/pod/poderrs.t
+ !> t/pod/poderrs.xr
+____________________________________________________________________________
+[ 4590] By: gsar on 1999/11/16 05:57:56
+ Log: Pod::Parser updates (v1.091) from Brad Appleton <bradapp@enteract.com>
+ Branch: perl
+ ! lib/Pod/Checker.pm lib/Pod/InputObjects.pm lib/Pod/Parser.pm
+ ! lib/Pod/Select.pm lib/Pod/Usage.pm pod/podchecker.PL
+ ! t/pod/poderrs.t t/pod/poderrs.xr
+____________________________________________________________________________
+[ 4589] By: gsar on 1999/11/15 18:47:34
+ Log: add a synchronous stub fork() for USE_ITHREADS to prove that a simple
+ C<if (fork()) { print "parent" } else { print "child" }> works on
+ Windows (incidentally running a cloned^2 interpreter :)
+ Branch: perl
+ ! embed.h embed.pl global.sym makedef.pl objXSUB.h perlapi.c
+ ! pp_sys.c proto.h sv.c
+____________________________________________________________________________
+[ 4588] By: gsar on 1999/11/15 14:34:36
+ Log: cloning the stack (part 1)
+ Branch: perl
+ ! cop.h deb.c perl.c sv.c
+____________________________________________________________________________
+[ 4587] By: jhi on 1999/11/15 00:22:20
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> Changes embed.h embed.pl embedvar.h global.sym intrpvar.h
+ !> makedef.pl objXSUB.h op.c perl.h perlapi.c proto.h run.c sv.c
+ !> win32/perllib.c
+____________________________________________________________________________
+[ 4586] By: jhi on 1999/11/14 21:17:26
+ Log: Ilya's "hopscotch" patch, reworked by Ilya to fit.
+ Branch: cfgperl
+ ! embed.h embed.pl embedvar.h proto.h regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 4585] By: gsar on 1999/11/14 20:01:45
+ Log: tweak for win32 build
+ Branch: perl
+ ! embed.h embed.pl op.c proto.h
+____________________________________________________________________________
+[ 4584] By: gsar on 1999/11/14 19:46:25
+ Log: cosmetic tweaks
+ Branch: perl
+ ! embed.h embed.pl embedvar.h global.sym intrpvar.h makedef.pl
+ ! objXSUB.h perl.h perlapi.c proto.h sv.c win32/perllib.c
+____________________________________________________________________________
+[ 4583] By: gsar on 1999/11/14 17:38:32
+ Log: fix problem pointer casts
+ Branch: perl
+ ! Changes run.c sv.c
+____________________________________________________________________________
+[ 4582] By: jhi on 1999/11/14 17:10:01
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> cop.h dump.c ext/Opcode/Opcode.xs gv.c op.c perl.c perly.c
+ !> perly.y pp_ctl.c pp_sys.c sv.c t/op/misc.t toke.c util.c
+ !> vms/perly_c.vms win32/perllib.c
+____________________________________________________________________________
+[ 4581] By: jhi on 1999/11/14 17:08:23
+ Log: The separation of 64-bitness and largefileness continues
+ (with a setback, see hpux.sh).
+ Branch: cfgperl
+ ! Configure MANIFEST config_h.SH hints/aix.sh hints/hpux.sh
+ ! hints/solaris_2.sh
+ Branch: metaconfig
+ ! U/threads/archname.U U/typedefs/lseektype.U
+ Branch: metaconfig/U/perl
+ ! fpossize.U use64bits.U uselfs.U
+____________________________________________________________________________
+[ 4580] By: jhi on 1999/11/14 13:26:41
+ Log: Another Unicode update.
+ Branch: cfgperl
+ + lib/unicode/Jamo.txt lib/unicode/NamesList.html
+ + lib/unicode/UCD300.html lib/unicode/Unicode3.html
+ - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html
+ ! (edit 189 files)
+____________________________________________________________________________
+[ 4579] By: gsar on 1999/11/14 10:21:49
+ Log: sundry cleanups for cloned interpreters (only known failure mode
+ is due to regexps keeping non-constant data in their compiled
+ structures)
+ Branch: perl
+ ! cop.h dump.c ext/Opcode/Opcode.xs gv.c op.c perl.c pp_ctl.c
+ ! pp_sys.c sv.c toke.c util.c win32/perllib.c
+____________________________________________________________________________
+[ 4578] By: gsar on 1999/11/14 03:37:37
+ Log: fix bug in change#4515 (STOP blocks now see @ARGV like the rest)
+ Branch: perl
+ ! perly.c perly.y t/op/misc.t vms/perly_c.vms
+____________________________________________________________________________
+[ 4577] By: jhi on 1999/11/13 19:50:24
+ Log: Change #4576 accidentally leaked also parts of
+ Ilya's patch that won't apply cleanly anymore.
+ Branch: cfgperl
+ ! regexec.c t/op/re_tests
+____________________________________________________________________________
+[ 4576] By: jhi on 1999/11/13 19:43:37
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ ! embed.h embed.pl embedvar.h proto.h regexec.c t/op/re_tests
+ !> ext/Errno/Errno_pm.PL ext/IO/lib/IO/Socket.pm t/lib/dumper.t
+ !> t/op/regexp.t t/pragma/overload.t
+____________________________________________________________________________
+[ 4575] By: gsar on 1999/11/13 19:41:46
+ Log: typos in change#4561 and change#4565
+ Branch: perl
+ ! ext/Errno/Errno_pm.PL ext/IO/lib/IO/Socket.pm
+____________________________________________________________________________
+[ 4574] By: gsar on 1999/11/13 19:31:19
+ Log: revert non-kosher parts of change#4562 (sort order problems
+ should be ignored (on ebcdic) by fixing dumper.t/T() to sort
+ result and expected lines; /[:ascii:]/ not working should be
+ fixed, not ignored in regexp.t; result from sort should be
+ fixed to be ascii portable on ebcdic, not ebcdic-specific)
+ Branch: perl
+ ! t/lib/dumper.t t/op/regexp.t t/pragma/overload.t
+____________________________________________________________________________
+[ 4573] By: gsar on 1999/11/13 19:13:04
+ Log: integrate cfgperl changes into mainline
+ Branch: perl
+ +> lib/unicode/Eq/Latin1.pl lib/unicode/Eq/Unicode.pl
+ +> lib/unicode/In/BopomofoExtended.pl
+ +> lib/unicode/In/BraillePatterns.pl
+ +> lib/unicode/In/CJKRadicalsSupplement.pl
+ +> lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl
+ +> lib/unicode/In/Cherokee.pl
+ +> lib/unicode/In/IdeographicDescriptionCharacters.pl
+ +> lib/unicode/In/KangxiRadicals.pl lib/unicode/In/Khmer.pl
+ +> lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl
+ +> lib/unicode/In/Ogham.pl lib/unicode/In/Runic.pl
+ +> lib/unicode/In/Sinhala.pl lib/unicode/In/Syriac.pl
+ +> lib/unicode/In/Thaana.pl
+ +> lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl
+ +> lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl
+ - lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode
+ !> (integrate 213 files)
+____________________________________________________________________________
+[ 4572] By: jhi on 1999/11/13 18:44:50
+ Log: From: "Craig A. Berry" <craig.berry@metamor.com>
+ To: perl5-porters@perl.org, VMSPERL@perl.org
+ Subject: [PATCH 5.005_03 and 5.005_62] updates to README.vms
+ Date: Wed, 27 Oct 1999 11:02:54 -0500
+ Message-Id: <4.2.0.58.19991027105257.00addc10@mmtnt11.metamor.com>
+ Branch: cfgperl
+ ! README.vms
+____________________________________________________________________________
+[ 4571] By: jhi on 1999/11/13 18:33:39
+ Log: From: jand@activestate.com (Jan Dubois)
+ To: perl5-porters@perl.org, Perl-Win32-Porters@activestate.com
+ Cc: Douglas Lankshear <dougl@activestate.com>,
+ Gurusamy Sarathy <gsar@activestate.com>
+ Subject: [5.005_62 PATCH] support link() on WinNT and NTFS
+ Date: Tue, 09 Nov 1999 00:38:33 +0100
+ Message-ID: <382b5d24.10899522@smtprelay.t-online.de>
+ Branch: cfgperl
+ ! XSUB.h iperlsys.h pp_sys.c t/io/fs.t win32/config.bc
+ ! win32/config.gc win32/config.vc win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/perllib.c
+ ! win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 4570] By: jhi on 1999/11/13 18:30:37
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] makedef.pl goof
+ Date: Mon, 8 Nov 1999 23:55:21 -0500 (EST)
+ Message-Id: <199911090455.XAA25627@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! makedef.pl
+____________________________________________________________________________
+[ 4569] By: jhi on 1999/11/13 18:06:54
+ Log: From: Michael G Schwern <schwern@pobox.com>
+ To: perl5-porters@perl.org, pod-people@perl.org
+ Cc: tchrist@mox.perl.com, gnat@frii.com
+ Subject: [DOCPATCH 5.005_62 perlfaq9.pod] Mention HTML::FormatText
+ Date: Wed, 10 Nov 1999 17:21:46 -0500
+ Message-ID: <19991110172146.A23527@athens.aocn.com>
+ Branch: cfgperl
+ ! pod/perlfaq9.pod
+____________________________________________________________________________
+[ 4568] By: jhi on 1999/11/13 18:05:33
+ Log: From: "Paul Moore" <gustav@morpheus.demon.co.uk>
+ To: <perl5-porters@perl.org>
+ Subject: DynaLoader_pm.PL patch (backslashes in strings)
+ Date: Wed, 10 Nov 1999 22:52:02 -0000
+ Message-ID: <LPBBIIMJKJMPNOGHGLLCMEBFCAAA.gustav@morpheus.demon.co.uk>
+ Branch: cfgperl
+ ! ext/DynaLoader/DynaLoader_pm.PL
+____________________________________________________________________________
+[ 4567] By: jhi on 1999/11/13 18:03:52
+ Log: From: JD Laub <jdl@access-health.com>
+ To: perl5-porters@perl.org
+ Subject: [ID 19991112.002] patch: Exporter.pm not reporting path
+ Date: Fri, 12 Nov 1999 08:58:28 -0700 (MST)
+ Message-Id: <199911121558.IAA08915@mocha.iasi.com>
+ Branch: cfgperl
+ ! lib/Exporter/Heavy.pm
+____________________________________________________________________________
+[ 4566] By: jhi on 1999/11/13 18:01:24
+ Log: From: Bernard Quatermass <bernard@quatermass.co.uk>
+ To: perl5-porters@perl.org
+ Subject: small patch for perldoc
+ Date: Fri, 12 Nov 1999 23:11:43 GMT
+ Message-Id: <VA.0000001c.00d1e05a@quatermass.co.uk>
+ Branch: cfgperl
+ ! utils/perldoc.PL
+____________________________________________________________________________
+[ 4565] By: jhi on 1999/11/13 17:58:54
+ Log: From: Scott Gifford <sgifford@tir.com>
+ To: perl5-porters@perl.org
+ Cc: gbarr@pobox.com
+ Subject: [ID 19991112.004] Bug in IO::Socket (patch included)
+ Date: 12 Nov 1999 18:55:30 -0500
+ Message-Id: <m3emdvw9hp.fsf@sgifford.tir.com>
+ Branch: cfgperl
+ ! ext/IO/lib/IO/Socket.pm
+____________________________________________________________________________
+[ 4564] By: jhi on 1999/11/13 17:45:39
+ Log: Applied manually:
+ From: "Craig A. Berry" <craig.berry@metamor.com>
+ To: perl5-porters@perl.org, VMSPERL@perl.org
+ Subject: [PATCH 5.005_62] patches required to build on VMS
+ Date: Tue, 09 Nov 1999 18:16:14 -0600
+ Message-Id: <4.2.2.19991109173839.00d12630@mmtnt11.metamor.com>
+ Branch: cfgperl
+ ! configure.com vms/descrip_mms.template vms/subconfigure.com
+ ! vms/vms.c vms/vmsish.h
+____________________________________________________________________________
+[ 4563] By: jhi on 1999/11/13 17:18:41
+ Log: Regen Unicode tables to include a warning:
+ Thou Shalt Not Edit Them By Hand; add missing
+ (Unicode 2.0 -introduced) tables to MANIFEST;
+ convert the equivalence tables to be valid Perl code.
+ Branch: cfgperl
+ + lib/unicode/Eq/Latin1.pl lib/unicode/Eq/Unicode.pl
+ + lib/unicode/In/BopomofoExtended.pl
+ + lib/unicode/In/BraillePatterns.pl
+ + lib/unicode/In/CJKRadicalsSupplement.pl
+ + lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl
+ + lib/unicode/In/Cherokee.pl
+ + lib/unicode/In/IdeographicDescriptionCharacters.pl
+ + lib/unicode/In/KangxiRadicals.pl lib/unicode/In/Khmer.pl
+ + lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl
+ + lib/unicode/In/Ogham.pl lib/unicode/In/Runic.pl
+ + lib/unicode/In/Sinhala.pl lib/unicode/In/Syriac.pl
+ + lib/unicode/In/Thaana.pl
+ + lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl
+ + lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl
+ - lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode
+ ! (edit 169 files)
+____________________________________________________________________________
+[ 4562] By: jhi on 1999/11/13 16:53:00
+ Log: From: Peter Prymmer <pvhp@forte.com>
+ To: gsar@activestate.com, perl-mvs@perl.org, perlbug@perl.com
+ Subject: [PATCH: 5.005_62]was Re: [ID 19991102.003] perl on os390
+ Date: Wed, 10 Nov 1999 14:34:36 -0800 (PST)
+ Message-Id: <199911102234.OAA01018@brio.forte.com>
+ Branch: cfgperl
+ ! t/lib/dumper.t t/op/pack.t t/op/regexp.t t/pragma/locale.t
+ ! t/pragma/overload.t
+____________________________________________________________________________
+[ 4561] By: jhi on 1999/11/13 16:29:37
+ Log: $Config{myarchname} is not a good architecture identifier
+ because it may contain host/node identification like
+ CPU serial numbers.
+ Branch: cfgperl
+ ! ext/Errno/Errno_pm.PL
+____________________________________________________________________________
+[ 4560] By: jhi on 1999/11/13 16:26:13
+ Log: Continue largefileness separation from quadness;
+ move nv-preserving test out of perl.h into Configure;
+ use HAS_SETVBUF in IO.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH ext/IO/IO.xs hints/solaris_2.sh perl.h pp_sys.c
+ Branch: metaconfig
+ ! U/a_dvisory/quadtype.U
+ Branch: metaconfig/U/perl
+ + nvpresuv.U
+ ! d_fseeko.U d_ftello.U io64.U perlxv.U
+____________________________________________________________________________
+[ 4559] By: jhi on 1999/11/13 13:46:38
+ Log: Try to fix largefileness so that it "works" without a quad IV.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH perl.h pp_sys.c t/lib/syslfs.t t/op/lfs.t
+ Branch: metaconfig
+ ! U/a_dvisory/quadtype.U U/typedefs/lseektype.U
+ Branch: metaconfig/U/perl
+ ! io64.U
+____________________________________________________________________________
+[ 4558] By: jhi on 1999/11/13 11:36:19
+ Log: Undo drift from mainline.
+ Branch: cfgperl
+ ! regcomp.c util.c utils/h2xs.PL
+____________________________________________________________________________
+[ 4557] By: gsar on 1999/11/13 10:54:46
+ Log: typo
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 4556] By: gsar on 1999/11/13 10:53:41
+ Log: integrate cfgperl contents (op.[ch] needed manual resolve)
+ Branch: perl
+ +> epoc/Config.pm epoc/autosplit.pl epoc/createpkg.pl
+ +> epoc/epoc_stubs.c
+ !> (integrate 48 files)
+____________________________________________________________________________
+[ 4555] By: jhi on 1999/11/13 10:05:54
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> dump.c ext/Devel/DProf/DProf.xs gv.c mg.c op.c perl.c pp.c
+ !> sv.c warnings.h warnings.pl win32/Makefile win32/perllib.c
+____________________________________________________________________________
+[ 4554] By: jhi on 1999/11/13 10:03:07
+ Log: s/_SIGN$/_sign/g;
+ Branch: metaconfig
+ ! U/typedefs/gidsign.U U/typedefs/pidsign.U U/typedefs/uidsign.U
+____________________________________________________________________________
+[ 4553] By: gsar on 1999/11/13 02:17:53
+ Log: cloned interpreters now actually run and pass all but 55/10386
+ subtests; various subtle bugs, new and old, observed when running
+ cloned interpreters have been fixed
+
+ still to do:
+ | * dup psig_ptr table
+ | * merge PADOP GVs support with "our" SVs (existing PADOPs are too
+ | simple-minded and grab one pad entry each, heavily bloating
+ | the pad by not avoiding dups)
+ | * overloaded constants are not really immutable--they need to
+ | be PADOPs
+ | * allocator for constants and OPs need to be spelled differently
+ | (shared vs interpreter-local allocations)
+ | * optree refcounting is still missing locking (macros are in place)
+ | * curstackinfo, {mark,scope,save,ret}stack need to be cloned so
+ | perl_clone() can be called from within runops*()
+ Branch: perl
+ ! dump.c ext/Devel/DProf/DProf.xs gv.c mg.c op.c perl.c pp.c
+ ! sv.c warnings.h warnings.pl win32/Makefile win32/perllib.c
+____________________________________________________________________________
+[ 4552] By: jhi on 1999/11/11 23:17:43
+ Log: Turn on largefileness always if available and
+ continue 64-bit fixes.
+ Branch: cfgperl
+ ! Configure config_h.SH handy.h hints/aix.sh hints/dec_osf.sh
+ ! hints/hpux.sh hints/irix_6.sh hints/solaris_2.sh perl.h pp.c
+ ! sv.c t/lib/syslfs.t t/op/lfs.t utf8.c
+____________________________________________________________________________
+[ 4551] By: jhi on 1999/11/11 23:16:15
+ Log: Split int64type from i_inttypes, rename quadcase into quadkind.
+ Branch: metaconfig
+ ! U/a_dvisory/quadtype.U
+ Branch: metaconfig/U/perl
+ + d_int64t.U
+ ! i_inttypes.U io64.U
+____________________________________________________________________________
+[ 4550] By: jhi on 1999/11/11 20:24:55
+ Log: Fix a thinko in 4548.
+ Branch: cfgperl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 4549] By: jhi on 1999/11/11 19:48:21
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> (integrate 56 files)
+____________________________________________________________________________
+[ 4548] By: jhi on 1999/11/11 19:41:56
+ Log: Try to do something if st_size, st_uid, st_gid are too big for an IV;
+ regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH pp_sys.c
+____________________________________________________________________________
+[ 4547] By: jhi on 1999/11/11 19:40:38
+ Log: s/_SIZE$/_size/g; add sizesize and ssizesize.
+ Branch: metaconfig
+ + U/typedefs/sizesize.U U/typedefs/ssizesize.U
+ ! U/typedefs/gidsize.U U/typedefs/pidsize.U U/typedefs/uidsize.U
+____________________________________________________________________________
+[ 4546] By: gsar on 1999/11/11 10:32:54
+ Log: avoid stash pointers in optree under USE_ITHREADS
+ Branch: perl
+ ! bytecode.pl cop.h ext/B/B.xs ext/B/B/Asmdata.pm
+ ! ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/Debug.pm
+ ! ext/B/B/Deparse.pm ext/ByteLoader/bytecode.h
+ ! ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h
+ ! ext/Opcode/Opcode.xs gv.c op.c perl.c pp.c pp_ctl.c pp_hot.c
+ ! scope.h sv.c
+____________________________________________________________________________
+[ 4545] By: gsar on 1999/11/11 06:04:20
+ Log: another change towards a shareable optree: avoid pointer to filegv
+ in COP; revert parts of change#4485 and s/xcv_filegv/xcv_file/
+ (CvFILE() may yet come in handy somewhere); adjust compiler doodads
+ to suit
+ Branch: perl
+ ! bytecode.pl cop.h cv.h dump.c ext/B/B.pm ext/B/B.xs
+ ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm
+ ! ext/B/B/CC.pm ext/B/B/Debug.pm ext/B/B/Deparse.pm
+ ! ext/B/B/Lint.pm ext/B/B/Xref.pm ext/ByteLoader/bytecode.h
+ ! ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h
+ ! ext/Devel/Peek/Peek.pm gv.c gv.h op.c perl.c pp.c pp_ctl.c
+ ! pp_sys.c scope.c scope.h sv.c sv.h toke.c util.c util.h
+ ! win32/perllib.c
+____________________________________________________________________________
+[ 4544] By: gsar on 1999/11/10 18:19:12
+ Log: more cleanups for change#4539
+ Branch: perl
+ ! gv.h op.c op.h pp_ctl.c pp_hot.c
+____________________________________________________________________________
+[ 4543] By: gsar on 1999/11/10 01:52:22
+ Log: remove dead branch/infinite looper in change#3612
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 4542] By: gsar on 1999/11/09 20:05:47
+ Log: IoDIRP may be fake when used in source filters, mark as such
+ Branch: perl
+ ! sv.c sv.h toke.c
+____________________________________________________________________________
+[ 4541] By: gsar on 1999/11/09 05:47:53
+ Log: small nits in changes#4538,4539
+ Branch: perl
+ ! op.c sv.c
+____________________________________________________________________________
+[ 4540] By: gsar on 1999/11/08 20:30:58
+ Log: win32 symbol export tweak
+ Branch: perl
+ ! makedef.pl win32/win32.c win32/win32iop.h
+____________________________________________________________________________
+[ 4539] By: gsar on 1999/11/08 18:50:40
+ Log: preliminary support for GVOP indirection via pad
+ Branch: perl
+ ! doio.c dump.c embed.h embed.pl global.sym objXSUB.h op.c op.h
+ ! opcode.pl perlapi.c pp_hot.c pp_sys.c proto.h run.c
+____________________________________________________________________________
+[ 4538] By: gsar on 1999/11/08 11:25:49
+ Log: preliminary support for perl_clone() (still needs work in
+ the following areas: SVOPs must indirect via pad; context
+ stack, scope stack, and runlevels must be cloned; must
+ hook up the virtualized pseudo-process support provided by
+ "host"; ...)
+ Branch: perl
+ ! av.h embed.h embed.pl embedvar.h global.sym hv.c hv.h
+ ! intrpvar.h makedef.pl objXSUB.h perl.h perlapi.c proto.h sv.c
+ ! win32/perllib.c win32/win32.c
+____________________________________________________________________________
+[ 4537] By: gsar on 1999/11/08 11:19:18
+ Log: more thorough cleanup in perl_destroy()
+ Branch: perl
+ ! perl.c util.c
+____________________________________________________________________________
+[ 4536] By: gsar on 1999/11/08 07:16:10
+ Log: win32 internal data must be interpreter-local
+ Branch: perl
+ ! win32/win32.c win32/win32.h win32/win32sck.c
+____________________________________________________________________________
+[ 4535] By: gsar on 1999/11/08 04:17:28
+ Log: tweak change#4502
+ Branch: perl
+ ! doio.c perl.c
+____________________________________________________________________________
+[ 4534] By: jhi on 1999/11/07 13:17:03
+ Log: Four special class subs, not three.
+ Branch: cfgperl
+ ! pod/perlmod.pod
+____________________________________________________________________________
+[ 4533] By: jhi on 1999/11/07 13:13:15
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> mg.c t/io/print.t
+____________________________________________________________________________
+[ 4532] By: jhi on 1999/11/07 12:36:10
+ Log: More test program maintenance.
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: metaconfig
+ ! U/a_dvisory/intsize.U U/compline/alignbytes.U
+ ! U/compline/charsize.U U/compline/d_sigaction.U
+ ! U/compline/doublesize.U U/compline/floatsize.U
+ ! U/compline/nblock_io.U U/compline/ptrsize.U
+ ! U/modified/Signal.U U/typedefs/gidsize.U U/typedefs/pidsize.U
+ ! U/typedefs/uidsize.U
+ Branch: metaconfig/U/perl
+ ! fpossize.U
+____________________________________________________________________________
+[ 4531] By: jhi on 1999/11/07 00:34:09
+ Log: Tidy up the metaconfig test programs.
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: metaconfig
+ ! U/a_dvisory/intsize.U U/compline/alignbytes.U
+ ! U/compline/charsize.U U/compline/doublesize.U
+ ! U/compline/nblock_io.U U/compline/ptrsize.U
+ ! U/modified/d_longlong.U U/typedefs/gidsize.U
+ ! U/typedefs/lseektype.U U/typedefs/pidsize.U
+ ! U/typedefs/uidsize.U
+ Branch: metaconfig/U/perl
+ ! fpossize.U
+____________________________________________________________________________
+[ 4530] By: jhi on 1999/11/06 23:51:34
+ Log: So many printfs, so little time.
+ Branch: cfgperl
+ ! op.c perl.c regcomp.c scope.c util.c
+____________________________________________________________________________
+[ 4529] By: jhi on 1999/11/06 23:27:35
+ Log: Replace the explicit zeros with NOOPs.
+ Branch: cfgperl
+ ! perl.h
+____________________________________________________________________________
+[ 4528] By: jhi on 1999/11/06 23:10:54
+ Log: From: jand@activestate.com (Jan Dubois)
+ To: perl5-porters@perl.org
+ Cc: Mike Blazer <blazer@mail.nevalink.ru>,
+ Mark Borgerding <mborgerding@acm.org>
+ Subject: [5.005_62 PATCH] binmode and locale support for -T and -B filetest operators
+ Date: Sat, 06 Nov 1999 22:16:43 +0100
+ Message-ID: <38279207.46448719@smtprelay.t-online.de>
+ Branch: cfgperl
+ ! op.c op.h
+____________________________________________________________________________
+[ 4527] By: jhi on 1999/11/06 20:22:14
+ Log: ...and fewer.
+ Branch: cfgperl
+ ! dump.c
+____________________________________________________________________________
+[ 4526] By: jhi on 1999/11/06 20:19:04
+ Log: ...and they are getting fewer.
+ Branch: cfgperl
+ ! dump.c op.c util.c
+____________________________________________________________________________
+[ 4525] By: jhi on 1999/11/06 19:59:59
+ Log: More printf miscasts flushed out.
+ Branch: cfgperl
+ ! dump.c ext/B/B.xs ext/Data/Dumper/Dumper.xs regcomp.c
+ ! regexec.c
+____________________________________________________________________________
+[ 4524] By: jhi on 1999/11/06 15:39:05
+ Log: Crushing the remaining %ld guerillas.
+ Branch: cfgperl
+ ! ext/Devel/DProf/DProf.xs
+____________________________________________________________________________
+[ 4523] By: jhi on 1999/11/06 15:11:38
+ Log: Update CPAN sites list.
+ Branch: cfgperl
+ ! pod/perlmodlib.pod
+____________________________________________________________________________
+[ 4522] By: jhi on 1999/11/05 19:50:46
+ Log: The -n32 is normally part of $cc, not $ccflags.
+ Branch: cfgperl
+ ! hints/irix_6.sh
+____________________________________________________________________________
+[ 4521] By: gsar on 1999/11/05 04:35:30
+ Log: allow $\ to work right when set to a string with embedded nulls
+ Branch: perl
+ ! mg.c t/io/print.t
+____________________________________________________________________________
+[ 4520] By: jhi on 1999/11/04 23:30:09
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> embedvar.h ext/B/B/Bytecode.pm ext/B/B/Lint.pm
+ !> ext/B/B/Stash.pm ext/B/NOTES ext/B/O.pm ext/File/Glob/Glob.pm
+ !> ext/File/Glob/bsd_glob.c ext/File/Glob/bsd_glob.h intrpvar.h
+ !> keywords.h keywords.pl objXSUB.h op.c perl.c pod/perldelta.pod
+ !> pod/perldiag.pod pod/perlfunc.pod pod/perlmod.pod
+ !> pod/perlrun.pod pod/perlsub.pod pod/perltodo.pod toke.c
+____________________________________________________________________________
+[ 4519] By: jhi on 1999/11/04 23:09:25
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] ref to non-lvalue method
+ Date: Wed, 3 Nov 1999 03:52:48 -0500 (EST)
+ Message-Id: <199911030852.DAA06563@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! op.c
+____________________________________________________________________________
+[ 4518] By: jhi on 1999/11/04 23:07:27
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] xsubpp dependency
+ Date: Wed, 3 Nov 1999 02:57:23 -0500 (EST)
+ Message-Id: <199911030757.CAA06325@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! lib/ExtUtils/MM_Unix.pm
+____________________________________________________________________________
+[ 4517] By: jhi on 1999/11/04 23:05:59
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] regexp.h
+ Date: Wed, 3 Nov 1999 02:55:21 -0500 (EST)
+ Message-Id: <199911030755.CAA06311@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! regexp.h
+____________________________________________________________________________
+[ 4516] By: gsar on 1999/11/04 18:25:45
+ Log: change#4485 didn't do the right thing for B::Bytecode
+ Branch: perl
+ ! ext/B/B/Bytecode.pm
+____________________________________________________________________________
+[ 4515] By: gsar on 1999/11/04 17:28:29
+ Log: implement STOP blocks and fix compiler to use them (minimally
+ tested)
+ Branch: perl
+ ! embedvar.h ext/B/B/Lint.pm ext/B/B/Stash.pm ext/B/NOTES
+ ! ext/B/O.pm intrpvar.h keywords.h keywords.pl objXSUB.h op.c
+ ! perl.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! pod/perlmod.pod pod/perlrun.pod pod/perlsub.pod
+ ! pod/perltodo.pod toke.c
+____________________________________________________________________________
+[ 4514] By: gsar on 1999/11/04 15:59:46
+ Log: display BSD license in Glob.pm (for clause #2 conformity)
+ Branch: perl
+ ! ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c
+ ! ext/File/Glob/bsd_glob.h
+____________________________________________________________________________
+[ 4513] By: jhi on 1999/11/04 08:26:19
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ +> t/io/nargv.t
+ !> (integrate 34 files)
+____________________________________________________________________________
+[ 4512] By: jhi on 1999/11/04 08:01:25
+ Log: Incremental Mac integration from Matthias.
+ Branch: cfgperl
+ ! perl.c perl.h pp_ctl.c pp_hot.c run.c sv.c t/pod/testpchk.pl
+ ! toke.c util.c
+____________________________________________________________________________
+[ 4511] By: gsar on 1999/11/04 02:53:37
+ Log: remove VIRTUAL tag, PERL_OBJECT doesn't need it anymore
+ Branch: perl
+ ! dosish.h embed.pl mg.c os2/os2ish.h perl.c perl.h perly.c
+ ! perly_c.diff pp_ctl.c proto.h regcomp.c regexec.c sv.c toke.c
+ ! universal.c vms/perly_c.vms vms/vmsish.h win32/win32.h
+ ! xsutils.c
+____________________________________________________________________________
+[ 4510] By: jhi on 1999/11/02 22:12:29
+ Log: S_init_interp is a better place to diddle with PL_opargs
+ than perl_construct.
+ Branch: cfgperl
+ ! perl.c
+____________________________________________________________________________
+[ 4509] By: jhi on 1999/11/02 21:30:02
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ To: ben@mucus.advanced.org, perl5-porters@perl.org
+ Subject: Re: [ID 19991102.002] unpack('N', pack('N', -1)) not idempotent
+ Date: Tue, 02 Nov 1999 21:36:00 +0000
+ Message-Id: <E11ilay-00020o-00@taurus.cus.cam.ac.uk>
+ Branch: cfgperl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 4508] By: jhi on 1999/11/02 20:46:27
+ Log: Initial integration of the MacPerl changes form Matthias.
+ Branch: cfgperl
+ ! doio.c ext/DynaLoader/DynaLoader_pm.PL ext/Fcntl/Fcntl.pm
+ ! ext/Fcntl/Fcntl.xs gv.c mg.c opcode.pl perl.c perl.h pp_ctl.c
+ ! pp_hot.c pp_sys.c run.c sv.c toke.c util.c
+____________________________________________________________________________
+[ 4507] By: jhi on 1999/11/01 23:05:07
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: lvirden@cas.org (Larry W. Virden)
+ Cc: perl5-porters@perl.org, lvirden@cas.org
+ Subject: Re: [ID 19991026.001] perl segmentation fault report
+ Date: Mon, 1 Nov 1999 18:14:16 -0500 (EST)
+ Message-Id: <199911012314.SAA22664@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! regexec.c t/op/pat.t
+____________________________________________________________________________
+[ 4506] By: jhi on 1999/11/01 19:56:28
+ Log: From: Olaf Flebbe <olaf@science-computing.de>
+ To: perl5-porters@perl.org
+ Subject: [PATCH: 5.005_62] Patch for EPOC Support
+ Date: Mon, 1 Nov 1999 20:46:54 +0100 (MET)
+ Message-ID: <Pine.LNX.4.10.9911012045190.411-100000@dragon.science-computing.de>
+ Branch: cfgperl
+ + epoc/Config.pm epoc/autosplit.pl epoc/createpkg.pl
+ + epoc/epoc_stubs.c
+ ! MANIFEST README.epoc epoc/epocish.h epoc/perl.mmp
+ ! epoc/perl.pkg
+____________________________________________________________________________
+[ 4505] By: gsar on 1999/11/01 17:09:44
+ Log: macros for COP.cop_filegv access
+ Branch: perl
+ ! cop.h deb.c gv.c op.c perl.c pp_ctl.c pp_sys.c scope.c toke.c
+ ! util.c
+____________________________________________________________________________
+[ 4504] By: gsar on 1999/11/01 17:08:28
+ Log: enable better Win32::DomainName() by demand loading netapi32.dll
+ (from Jan Dubois)
+ Branch: perl
+ ! pod/Win32.pod win32/win32.c
+____________________________________________________________________________
+[ 4503] By: gsar on 1999/10/31 20:56:06
+ Log: change#4502 was missing a file
+ Branch: perl
+ + t/io/nargv.t
+____________________________________________________________________________
+[ 4502] By: gsar on 1999/10/31 20:46:02
+ Log: make nested ARGV/$^I loops work correctly; fixes several bugs
+ in the way ARGV state was handled in readline(); writing a
+ subroutine to do inplace edits is now possible, provided *ARGV,
+ *ARGVOUT, $^I and $_ are localized where needed
+ Branch: perl
+ ! MANIFEST doio.c embedvar.h intrpvar.h objXSUB.h perl.c
+ ! pp_hot.c scope.c
+____________________________________________________________________________
+[ 4501] By: jhi on 1999/10/31 12:43:54
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> perl.h win32/config.bc win32/config.gc win32/config.vc
+ !> win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 4500] By: gsar on 1999/10/31 10:01:17
+ Log: updated windows config* files
+ Branch: perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 4499] By: gsar on 1999/10/31 09:15:17
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ !> Configure Porting/Glossary Porting/config.sh Porting/config_H
+ !> config_h.SH perl.h
+____________________________________________________________________________
+[ 4498] By: gsar on 1999/10/31 09:13:41
+ Log: remove unused struct Outrec
+ Branch: perl
+ ! perl.h
+____________________________________________________________________________
+[ 4497] By: jhi on 1999/10/30 12:41:50
+ Log: Add HAS_QUAD ($Config{d_quad}); use it.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH perl.h
+ Branch: metaconfig
+ ! U/a_dvisory/quadtype.U U/compline/charsize.U U/typedefs/gidf.U
+ ! U/typedefs/uidf.U
+ Branch: metaconfig/U/perl
+ ! perlxv.U
+____________________________________________________________________________
+[ 4496] By: gsar on 1999/10/30 00:28:32
+ Log: integrate cfgperl contents into mainline
+ Branch: perl
+ !> Configure Policy_sh.SH Porting/Glossary Porting/config.sh
+ !> Porting/config_H README.hurd config_h.SH doop.c handy.h
+ !> hints/aix.sh hints/irix_6.sh hints/solaris_2.sh mg.c perl.c
+ !> perl.h pp.c pp.h regexec.c sv.c taint.c
+____________________________________________________________________________
+[ 4495] By: jhi on 1999/10/29 23:36:19
+ Log: Continue what #4494 started; introduce uid and gid formats.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH handy.h perl.h
+ Branch: metaconfig
+ + U/a_dvisory/quadtype.U U/typedefs/gidf.U U/typedefs/uidf.U
+ - U/typedefs/quadtype.U
+ Branch: metaconfig/U/perl
+ ! perlxv.U
+____________________________________________________________________________
+[ 4494] By: jhi on 1999/10/29 22:09:01
+ Log: Move the IV, UV, I8, U8, ..., and NV to metaconfig
+ from perl.h and handy.h.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH handy.h perl.h
+ Branch: metaconfig/U/perl
+ + perlxv.U perlxvf.U
+____________________________________________________________________________
+[ 4493] By: jhi on 1999/10/29 22:08:06
+ Log: Finetuning the output continues along the lines of #4490 and #4491.
+ Branch: metaconfig
+ ! U/modified/i_sysuio.U U/threads/d_pthreadj.U
+ ! U/typedefs/fpostype.U
+ Branch: metaconfig/U/perl
+ + fpossize.U
+ ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U
+ ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U
+____________________________________________________________________________
+[ 4492] By: jhi on 1999/10/29 21:14:53
+ Log: Hurd update from Mark Kettenis.
+ Branch: cfgperl
+ ! README.hurd
+____________________________________________________________________________
+[ 4491] By: jhi on 1999/10/29 20:37:02
+ Log: A new try at what #4490 tried to accomplish.
+ Branch: metaconfig
+ ! U/modified/i_sysuio.U U/threads/d_pthreadj.U
+ Branch: metaconfig/U/perl
+ ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U
+ ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U
+____________________________________________________________________________
+[ 4490] By: jhi on 1999/10/29 20:19:41
+ Log: metaconfig nits.
+ Branch: metaconfig
+ ! U/modified/i_sysuio.U U/threads/d_pthreadj.U
+ Branch: metaconfig/U/perl
+ + d_iovec_s.U
+ ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U
+ ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U
+____________________________________________________________________________
+[ 4489] By: jhi on 1999/10/29 16:08:43
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> (integrate 31 files)
+____________________________________________________________________________
+[ 4488] By: jhi on 1999/10/29 15:30:30
+ Log: Regen Configure and Glossary.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH
+____________________________________________________________________________
+[ 4487] By: jhi on 1999/10/29 15:24:13
+ Log: Remove quad logic from perl.h; regen Configure;
+ add -DUSE_LONG_LONG to ccflags if not already there.
+ Branch: cfgperl
+ ! Configure config_h.SH doop.c hints/aix.sh hints/irix_6.sh
+ ! hints/solaris_2.sh perl.h pp.c pp.h regexec.c sv.c
+____________________________________________________________________________
+[ 4486] By: jhi on 1999/10/29 15:22:38
+ Log: metaconfig: moved quad logic from perl.h to Configure (quadtype.U);
+ fixed the use*.U to define their stuff only iff not already defined
+ (so that ccflags can have any -DUSE_* it wants);
+ uselonglong.U added; various small nits fixed.
+ Branch: metaconfig
+ + U/typedefs/quadtype.U
+ ! U/modified/d_longdbl.U U/modified/d_longlong.U
+ ! U/modified/d_statblks.U U/modified/usenm.U
+ ! U/threads/usethreads.U
+ Branch: metaconfig/U/perl
+ + uselonglong.U
+ ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U
+ ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U i_inttypes.U
+ ! quadfio.U use64bits.U uselfs.U uselongdbl.U usemorebits.U
+ ! usemultiplicity.U useperlio.U usesocks.U
+____________________________________________________________________________
+[ 4485] By: gsar on 1999/10/29 06:08:50
+ Log: more cleanup: avoid unused knowledge of "file GV" notion in CV and GV
+ Branch: perl
+ ! bytecode.pl cv.h dump.c ext/B/B.pm ext/B/B.xs
+ ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm
+ ! ext/B/B/Debug.pm ext/B/B/Xref.pm ext/ByteLoader/byterun.c
+ ! ext/ByteLoader/byterun.h ext/Devel/Peek/Peek.pm gv.c gv.h op.c
+ ! sv.h
+____________________________________________________________________________
+[ 4484] By: gsar on 1999/10/29 03:00:21
+ Log: usurp GVOP slot for new PADOP (one small step to making optree
+ shareable across interpreters)
+ Branch: perl
+ ! bytecode.pl doio.c dump.c ext/B/B.pm ext/B/B.xs
+ ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm
+ ! ext/B/B/Debug.pm ext/B/B/Deparse.pm ext/B/B/Lint.pm
+ ! ext/B/B/Terse.pm ext/B/typemap ext/ByteLoader/byterun.c
+ ! ext/ByteLoader/byterun.h op.c op.h opcode.h opcode.pl perl.h
+ ! pp_hot.c pp_sys.c regexec.c run.c
+____________________________________________________________________________
+[ 4483] By: jhi on 1999/10/28 22:01:12
+ Log: Regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH
+____________________________________________________________________________
+[ 4482] By: jhi on 1999/10/28 21:45:26
+ Log: Installdirs patches from Andy.
+ Branch: metaconfig
+ ! U/installdirs/sitearch.U U/installdirs/sitebin.U
+ ! U/installdirs/sitehtml1dir.U U/installdirs/sitehtml3dir.U
+ ! U/installdirs/sitelib.U U/installdirs/siteman1dir.U
+ ! U/installdirs/siteman3dir.U U/installdirs/siteprefix.U
+ ! U/installdirs/sitescriptdir.U U/installdirs/vendorarch.U
+ ! U/installdirs/vendorbin.U U/installdirs/vendorhtml1dir.U
+ ! U/installdirs/vendorhtml3dir.U U/installdirs/vendorlib.U
+ ! U/installdirs/vendorman1dir.U U/installdirs/vendorman3dir.U
+ ! U/installdirs/vendorprefix.U U/installdirs/vendorscriptdir.U
+____________________________________________________________________________
+[ 4481] By: gsar on 1999/10/28 17:33:49
+ Log: remove C<use Time::Local 'no_range_check'> misfeature (global
+ can still be directly set)
+ Branch: perl
+ ! lib/Time/Local.pm
+____________________________________________________________________________
+[ 4480] By: jhi on 1999/10/28 13:49:26
+ Log: Fix printing of uids and gids; regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH mg.c perl.c perl.h taint.c
+____________________________________________________________________________
+[ 4479] By: jhi on 1999/10/28 11:53:57
+ Log: Fix typo.
+ Branch: metaconfig
+ ! U/typedefs/gidsize.U
+____________________________________________________________________________
+[ 4478] By: jhi on 1999/10/28 06:50:02
+ Log: Integrate with Sarathy.
+ Branch: cfgperl
+ !> Changes iperlsys.h makedef.pl patchlevel.h perl.h
+ !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc
+ !> win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ !> win32/config_sh.PL win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 4477] By: jhi on 1999/10/28 06:40:54
+ Log: (Slightly) better comments for Policy_sh.SH from Andy.
+ Branch: cfgperl
+ ! Policy_sh.SH
+____________________________________________________________________________
+[ 4476] By: gsar on 1999/10/27 23:54:36
+ Log: regen config* stuff for windows
+ Branch: perl
+ ! Changes patchlevel.h win32/Makefile win32/config.bc
+ ! win32/config.gc win32/config.vc win32/config_H.bc
+ ! win32/config_H.gc win32/config_H.vc win32/config_sh.PL
+ ! win32/makefile.mk
+____________________________________________________________________________
+[ 4475] By: gsar on 1999/10/27 21:32:30
+ Log: integrate cfgperl contents into mainline; merge conflicts
+ Branch: perl
+ !> (integrate 46 files)
+____________________________________________________________________________
+[ 4474] By: gsar on 1999/10/27 21:15:07
+ Log: patch up egcs-1.1.2-mingw32 build (builds a working miniperl, but not
+ perl; stdout/stderr redirects seem broken as well)
+ Branch: perl
+ ! iperlsys.h makedef.pl perl.h win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 4473] By: jhi on 1999/10/27 21:11:11
+ Log: Do not block if no message queues available.
+ Branch: cfgperl
+ ! t/lib/ipc_sysv.t
+____________________________________________________________________________
+[ 4472] By: jhi on 1999/10/27 18:27:40
+ Log: Remove unused "squatter" symbols; regen Configure.
+ Branch: cfgperl
+ ! Configure Makefile.SH Porting/Glossary Porting/config.sh
+ ! Porting/config_H config_h.SH epoc/config.h iperlsys.h perl.h
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+____________________________________________________________________________
+[ 4471] By: jhi on 1999/10/27 18:26:55
+ Log: metaconfig; split socket; fix output.
+ Branch: metaconfig
+ ! U/modified/d_socket.U U/modified/d_statblks.U
+ Branch: metaconfig/U/perl
+ + d_cmsghdr_s.U d_msghdr_s.U d_recvmsg.U d_sendmsg.U
+ ! i_sysstatfs.U i_sysvfs.U
+____________________________________________________________________________
+[ 4470] By: jhi on 1999/10/27 17:19:06
+ Log: Regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH perl.c perl.h
+____________________________________________________________________________
+[ 4469] By: jhi on 1999/10/27 17:18:41
+ Log: metaconfig; split statfs.
+ Branch: metaconfig/U/perl
+ + d_fs_data_s.U d_statfs_f_flags.U d_statfs_s.U
+ ! d_statfs.U
+____________________________________________________________________________
+[ 4468] By: jhi on 1999/10/27 14:06:44
+ Log: Integrate with Sarathy; manual resolve on regcomp.c conflicts
+ (Ilya's changes won).
+ Branch: cfgperl
+ +> os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm
+ +> os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST
+ +> os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t
+ !> (integrate 65 files)
+____________________________________________________________________________
+[ 4467] By: jhi on 1999/10/27 13:38:41
+ Log: Regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH
+____________________________________________________________________________
+[ 4466] By: jhi on 1999/10/27 13:18:06
+ Log: metaconfig fixes from Andy.
+ Branch: metaconfig
+ + U/modified/libnlist.U U/modified/usrinc.U
+ ! U/Glossary.patch U/mkglossary U/modified/libpth.U
+____________________________________________________________________________
+[ 4465] By: jhi on 1999/10/27 13:06:27
+ Log: Nosuid checking for statfs() people.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH perl.c perl.h pod/perldiag.pod
+____________________________________________________________________________
+[ 4464] By: jhi on 1999/10/27 13:04:20
+ Log: metaconfig maintenance; fix Hasfield, statfs;
+ add Hasstruct, statfs3, statfs4, ustat, sysvfs;
+ split fstatfs away from statfs.
+ Branch: metaconfig
+ + U/protos/Hasstruct.U
+ ! U/protos/Hasfield.U
+ Branch: metaconfig/U/perl
+ + d_fstatfs.U d_statfs3.U d_statfs4.U d_ustat.U i_sysvfs.U
+ + i_ustat.U
+ ! d_statfs.U
+____________________________________________________________________________
+[ 4463] By: jhi on 1999/10/27 07:55:53
+ Log: We need cc to be able to test for cc -v.
+ Branch: cfgperl
+ ! hints/dec_osf.sh
+____________________________________________________________________________
+[ 4462] By: gsar on 1999/10/27 01:31:41
+ Log: more GCC v2.95 induced adjustments
+ Branch: perl
+ ! globals.c mg.c opcode.h opcode.pl perl.h sv.c
+ ! win32/makefile.mk win32/win32.c x2p/walk.c
+____________________________________________________________________________
+[ 4461] By: gsar on 1999/10/26 21:42:59
+ Log: warnings and const violations identified by compiling in C++ mode
+ with GCC v2.95
+ Branch: perl
+ ! doio.c embed.pl mg.c op.c perl.c perlapi.c proto.h regcomp.c
+ ! sv.c taint.c toke.c win32/win32.c
+____________________________________________________________________________
+[ 4459] By: jhi on 1999/10/26 10:15:58
+ Log: Regen Configure.
+ Branch: cfgperl
+ ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+ ! config_h.SH
+____________________________________________________________________________
+[ 4458] By: jhi on 1999/10/26 09:48:37
+ Log: Minor rewordings.
+ Branch: metaconfig/U/perl
+ ! d_getmnt.U d_getmntent.U d_statfs.U d_statvfs.U
+____________________________________________________________________________
+[ 4456] By: jhi on 1999/10/26 09:11:49
+ Log: Fix d_statfsflags; add d_getmnt.
+ Branch: metaconfig/U/perl
+ + d_getmnt.U
+ ! d_statfs.U
+____________________________________________________________________________
+[ 4455] By: jhi on 1999/10/26 08:12:27
+ Log: Massive multitypo in #4446.
+ Branch: cfgperl
+ ! hints/dec_osf.sh
+____________________________________________________________________________
+[ 4454] By: jhi on 1999/10/25 08:28:45
+ Log: From: Laszlo Molnar <laszlo.molnar@eth.ericsson.se>
+ To: Perl 5 Porters <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_62] dos-djgpp update
+ Date: Mon, 25 Oct 1999 10:11:30 +0200
+ Message-ID: <19991025101130.K459@crater.eth.ericsson.se>
+ Branch: cfgperl
+ ! djgpp/config.over djgpp/configure.bat djgpp/djgppsed.sh
+ ! pod/perldelta.pod t/lib/io_unix.t
+____________________________________________________________________________
+[ 4453] By: jhi on 1999/10/25 08:25:50
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] Remove the last regnode<==>char*
+ Date: Mon, 25 Oct 1999 03:06:21 -0400 (EDT)
+ Message-Id: <199910250706.DAA16825@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! embed.h embed.pl proto.h regcomp.c regcomp.h regexec.c
+____________________________________________________________________________
+[ 4452] By: jhi on 1999/10/25 08:16:55
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] Missing REx engine patch
+ Date: Sun, 24 Oct 1999 23:47:45 -0400 (EDT)
+ Message-Id: <199910250347.XAA16094@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! pod/perldiag.pod regcomp.c regexec.c
+____________________________________________________________________________
+[ 4451] By: jhi on 1999/10/25 08:13:06
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.005_62] charnames and UTEST
+ Date: Sun, 24 Oct 1999 23:39:49 -0400 (EDT)
+ Message-Id: <199910250339.XAA16058@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! t/lib/charnames.t
+____________________________________________________________________________
+[ 4450] By: gsar on 1999/10/25 07:38:15
+ Log: win32 tweak
+ Branch: perl
+ ! win32/perllib.c
+____________________________________________________________________________
+[ 4449] By: gsar on 1999/10/24 23:20:10
+ Log: remove inconsistent tainting behavior of sprintf("%e",...)
+ (all bets are off is "C" locale is compromised)
+ Branch: perl
+ ! pod/perlfunc.pod pod/perllocale.pod sv.c
+____________________________________________________________________________
+[ 4448] By: gsar on 1999/10/24 22:20:42
+ Log: remove unused interpreter globals
+ Branch: perl
+ ! deb.c dump.c embed.h embed.pl embedvar.h ext/POSIX/POSIX.xs
+ ! global.sym gv.c gv.h intrpvar.h objXSUB.h perl.c perlapi.c
+ ! proto.h toke.c
+____________________________________________________________________________
+[ 4447] By: jhi on 1999/10/24 21:49:52
+ Log: Another hints tweak.
+ Branch: cfgperl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 4446] By: jhi on 1999/10/24 21:48:02
+ Log: Hints tweak.
+ Branch: cfgperl
+ ! hints/dec_osf.sh
+____________________________________________________________________________
+[ 4445] By: nick on 1999/10/24 21:03:28
+ Log: Integrate own changes to mainline.
+ Branch: utfperl
+ !> installperl pp.c
+____________________________________________________________________________
+[ 4444] By: nick on 1999/10/24 20:54:06
+ Log: Avoid creating GV with NULL name when vivifying nameless scalars.
+ (Fix/workround for [ID19991024.001])
+ Branch: perl
+ ! pp.c
+____________________________________________________________________________
+[ 4443] By: nick on 1999/10/24 15:09:51
+ Log: Follow that camel ... another sync.
+ Branch: utfperl
+ +> os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm
+ +> os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST
+ +> os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t
+ !> (integrate 36 files)
+____________________________________________________________________________
+[ 4442] By: gsar on 1999/10/24 14:40:01
+ Log: typo in installperl (from Paul Moore <gustav@morpheus.demon.co.uk>)
+ Branch: perl
+ ! installperl
+____________________________________________________________________________
+[ 4441] By: gsar on 1999/10/24 14:33:11
+ Log: test in change#4428 needs strict interpretation of C modulus
+ Branch: perl
+ ! t/op/int.t
+____________________________________________________________________________
+[ 4440] By: gsar on 1999/10/24 13:47:17
+ Log: don't allow SIGCHLD to be ignored at startup, or wait*() and
+ $? break
+ Branch: perl
+ ! perl.c pod/perldelta.pod pod/perldiag.pod
+____________________________________________________________________________
+[ 4439] By: jhi on 1999/10/24 13:19:17
+ Log: test for #2835 (yeah, better later than never)
+ Branch: cfgperl
+ ! t/op/array.t
+____________________________________________________________________________
+[ 4438] By: gsar on 1999/10/24 12:59:12
+ Log: typo, doc tweak
+ Branch: perl
+ ! lib/attributes.pm pod/perlop.pod
+____________________________________________________________________________
+[ 4437] By: gsar on 1999/10/24 11:59:55
+ Log: allow get() and reftype() functions to be imported (from
+ Spider Boardman)
+ Branch: perl
+ ! lib/attributes.pm
+____________________________________________________________________________
+[ 4436] By: gsar on 1999/10/24 11:52:53
+ Log: suppress scalar leak messages for known leaks (from
+ Robin Barker <rmb1@cise.npl.co.uk>)
+ Branch: perl
+ ! Changes t/op/lex_assign.t t/pragma/warn/op
+____________________________________________________________________________
[ 4435] By: gsar on 1999/10/24 11:39:42
Log: VMS tweak (suggested by Craig A. Berry <craig.berry@metamor.com>)
Branch: perl
!> Changes MANIFEST Makefile.SH Porting/makerel lib/Pod/Man.pm
!> lib/Pod/Parser.pm op.c pod/perldelta.pod pod/perlopentut.pod
!> win32/Makefile win32/makefile.mk
+
+----------------
+Version 5.005_62
+----------------
+
____________________________________________________________________________
[ 4391] By: gsar on 1999/10/15 10:12:42
Log: here be 5.005_62
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Sun Oct 3 02:41:02 EET DST 1999 [metaconfig 3.0 PL70]
+# Generated on Tue Nov 16 23:04:27 EET 1999 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.com)
cat >/tmp/c1$$ <<EOF
cf_email=''
cf_by=''
cf_time=''
+charsize=''
contains=''
cpp_stuff=''
cpplast=''
d_flexfnam=''
d_flock=''
d_fork=''
+d_fs_data_s=''
d_fseeko=''
d_fsetpos=''
+d_fstatfs=''
d_ftello=''
d_ftime=''
d_gettimeod=''
d_uname=''
d_gethostprotos=''
d_getlogin=''
+d_getmnt=''
d_getmntent=''
d_getnbyaddr=''
d_getnbyname=''
d_hasmntopt=''
d_htonl=''
d_inetaton=''
+d_int64t=''
d_isascii=''
d_killpg=''
d_lchown=''
d_longlong=''
longlongsize=''
d_lstat=''
-d_madvise=''
d_mblen=''
d_mbstowcs=''
d_mbtowc=''
d_mkdir=''
d_mkfifo=''
d_mktime=''
-d_mmap=''
-mmaptype=''
-d_mprotect=''
d_msg=''
d_msgctl=''
d_msgget=''
d_msgrcv=''
d_msgsnd=''
-d_msync=''
-d_munmap=''
d_nice=''
d_open3=''
d_fpathconf=''
d_seekdir=''
d_telldir=''
d_readlink=''
-d_readv=''
d_rename=''
d_rmdir=''
d_safebcpy=''
d_shmget=''
d_sigaction=''
d_sigsetjmp=''
-d_cmsghdr_s=''
d_msg_ctrunc=''
d_msg_dontroute=''
d_msg_oob=''
d_msg_peek=''
d_msg_proxy=''
-d_msghdr_s=''
d_oldsock=''
-d_recvmsg=''
d_scm_rights=''
-d_sendmsg=''
d_socket=''
d_sockpair=''
sockethdr=''
socketlib=''
+d_sqrtl=''
d_statblks=''
-d_fstatfs=''
-d_statfs=''
-d_statfsflags=''
+d_statfs_f_flags=''
+d_statfs_s=''
d_fstatvfs=''
d_statvfs=''
d_stdio_cnt_lval=''
d_semctl_semid_ds=''
d_semctl_semun=''
d_union_semun=''
+d_ustat=''
d_vfork=''
usevfork=''
d_voidsig=''
d_waitpid=''
d_wcstombs=''
d_wctomb=''
-d_writev=''
dlext=''
cccdlflags=''
ccdlflags=''
ebcdic=''
fflushNULL=''
fflushall=''
+fpossize=''
fpostype=''
+gidformat=''
+gidsign=''
+gidsize=''
gidtype=''
groupstype=''
h_fcntl=''
i_gdbm=''
d_grpasswd=''
i_grp=''
-d_int64t=''
i_inttypes=''
i_limits=''
i_locale=''
i_sysfilio=''
i_sysioctl=''
i_syssockio=''
-i_sysmman=''
i_sysmount=''
i_sysndir=''
i_sysparam=''
i_syssecrt=''
i_sysselct=''
i_sysstat=''
+i_sysstatfs=''
i_sysstatvfs=''
i_systimes=''
i_systypes=''
-d_iovec_s=''
i_sysuio=''
i_sysun=''
+i_sysvfs=''
i_syswait=''
i_sgtty=''
i_termio=''
i_time=''
timeincl=''
i_unistd=''
+i_ustat=''
i_utime=''
i_values=''
i_stdarg=''
longsize=''
shortsize=''
d_fpos64_t=''
-d_llseek=''
d_off64_t=''
libc=''
ldlibpthname=''
version=''
perladmin=''
perlpath=''
+i16size=''
+i16type=''
+i32size=''
+i32type=''
+i64size=''
+i64type=''
+i8size=''
+i8type=''
+ivsize=''
+ivtype=''
+nvsize=''
+nvtype=''
+u16size=''
+u16type=''
+u32size=''
+u32type=''
+u64size=''
+u64type=''
+u8size=''
+u8type=''
+uvsize=''
+uvtype=''
+ivdformat=''
+uvoformat=''
+uvuformat=''
+uvxformat=''
pidtype=''
prefix=''
prefixexp=''
sPRIo64=''
sPRIu64=''
sPRIx64=''
+d_quad=''
+quadkind=''
+quadtype=''
+uquadtype=''
drand01=''
randbits=''
randfunc=''
installsitearch=''
sitearch=''
sitearchexp=''
+installsitebin=''
+sitebin=''
+sitebinexp=''
installsitelib=''
sitelib=''
sitelibexp=''
d_strtoull=''
sysman=''
trnl=''
+uidformat=''
uidsign=''
+uidsize=''
uidtype=''
archname64=''
use64bits=''
uselargefiles=''
uselongdouble=''
+uselonglong=''
usemorebits=''
usemultiplicity=''
nm_opt=''
d_oldpthreads=''
usethreads=''
incpath=''
-mips=''
mips_type=''
usrinc=''
+d_vendorbin=''
+installvendorbin=''
+vendorbin=''
+vendorbinexp=''
d_vendorlib=''
installvendorlib=''
vendorlib=''
1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
esac
+: see how we invoke the C preprocessor
+echo " "
+echo "Now, how can we feed standard input to your C preprocessor..." >&4
+cat <<'EOT' >testcpp.c
+#define ABC abc
+#define XYZ xyz
+ABC.XYZ
+EOT
+cd ..
+if test ! -f cppstdin; then
+ if test "X$osname" = "Xaix" -a "X$gccversion" = X; then
+ # AIX cc -E doesn't show the absolute headerfile
+ # locations but we'll cheat by using the -M flag.
+ echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin
+ else
+ echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
+ fi
+else
+ echo "Keeping your $hint cppstdin wrapper."
+fi
+chmod 755 cppstdin
+wrapper=`pwd`/cppstdin
+ok='false'
+cd UU
-case "$usemorebits" in
-"$define"|true|[yY]*)
- use64bits="$define"
- uselongdouble="$define"
- usemorebits="$define"
- ;;
-*) usemorebits="$undef"
- ;;
-esac
-
-
-cat <<EOM
+if $test "X$cppstdin" != "X" && \
+ $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+then
+ echo "You used to use $cppstdin $cppminus so we'll use that again."
+ case "$cpprun" in
+ '') echo "But let's see if we can live without a wrapper..." ;;
+ *)
+ if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+ then
+ echo "(And we'll use $cpprun $cpplast to preprocess directly.)"
+ ok='true'
+ else
+ echo "(However, $cpprun $cpplast does not work, let's see...)"
+ fi
+ ;;
+ esac
+else
+ case "$cppstdin" in
+ '') ;;
+ *)
+ echo "Good old $cppstdin $cppminus does not seem to be of any help..."
+ ;;
+ esac
+fi
-Perl can be built to understand large files (files larger than 2 gigabytes)
-on some systems. To do so, Configure must be run with -Duselargefiles.
+if $ok; then
+ : nothing
+elif echo 'Maybe "'"$cc"' -E" will work...'; \
+ $cc -E <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yup, it does."
+ x_cpp="$cc -E"
+ x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \
+ $cc -E - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yup, it does."
+ x_cpp="$cc -E"
+ x_minus='-';
+elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \
+ $cc -P <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Yipee, that works!"
+ x_cpp="$cc -P"
+ x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \
+ $cc -P - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "At long last!"
+ x_cpp="$cc -P"
+ x_minus='-';
+elif echo 'No such luck, maybe "'$cpp'" will work...'; \
+ $cpp <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "It works!"
+ x_cpp="$cpp"
+ x_minus='';
+elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \
+ $cpp - <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "Hooray, it works! I was beginning to wonder."
+ x_cpp="$cpp"
+ x_minus='-';
+elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \
+ $wrapper <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ x_cpp="$wrapper"
+ x_minus=''
+ echo "Eureka!"
+else
+ dflt=''
+ rp="No dice. I can't find a C preprocessor. Name one:"
+ . ./myread
+ x_cpp="$ans"
+ x_minus=''
+ $x_cpp <testcpp.c >testcpp.out 2>&1
+ if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+ echo "OK, that will do." >&4
+ else
+echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4
+ exit 1
+ fi
+fi
-If this doesn't make any sense to you, just accept the default.
-EOM
-case "$uselargefiles" in
-"$define"|true|[yY]*) dflt='y' ;;
-*) dflt='n' ;;
-esac
-rp='Try to understand large files?'
-. ./myread
-case "$ans" in
-y|Y) val="$define" ;;
-*) val="$undef" ;;
-esac
-set uselargefiles
-eval $setvar
-case "$uselargefiles" in
-"$define") use64bits="$define" ;;
+case "$ok" in
+false)
+ cppstdin="$x_cpp"
+ cppminus="$x_minus"
+ cpprun="$x_cpp"
+ cpplast="$x_minus"
+ set X $x_cpp
+ shift
+ case "$1" in
+ "$cpp")
+ echo "Perhaps can we force $cc -E using a wrapper..."
+ if $wrapper <testcpp.c >testcpp.out 2>&1; \
+ $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+ then
+ echo "Yup, we can."
+ cppstdin="$wrapper"
+ cppminus='';
+ else
+ echo "Nope, we'll have to live without it..."
+ fi
+ ;;
+ esac
+ case "$cpprun" in
+ "$wrapper")
+ cpprun=''
+ cpplast=''
+ ;;
+ esac
+ ;;
esac
-cat <<EOM
-
-Perl can be built to take advantage of explicit 64-bit interfaces,
-on some systems. To do so, Configure must be run with -Duse64bits.
-
-If this doesn't make any sense to you, just accept the default.
-EOM
-case "$use64bits" in
-$define|true|[yY]*) dflt='y';;
-*) dflt='n';;
-esac
-rp='Try to use explicit 64-bit interfaces, if available?'
-. ./myread
-case "$ans" in
-y|Y)
- val="$define"
- ;;
-*)
- val="$undef"
- ;;
+case "$cppstdin" in
+"$wrapper"|'cppstdin') ;;
+*) $rm -f $wrapper;;
esac
-set use64bits
-eval $setvar
+$rm -f testcpp.c testcpp.out
-case "$archname64" in
-'') archname64='' ;; # not a typo
+: decide how portable to be. Allow command line overrides.
+case "$d_portable" in
+"$undef") ;;
+*) d_portable="$define" ;;
esac
-case "$use64bits" in
-"$define"|true|[yY]*)
-: Look for a hint-file generated 'call-back-unit'. If the
-: user has specified that a 64 bit perl is to be built,
-: we may need to set or change some other defaults.
- if $test -f use64bits.cbu; then
- echo "Your platform has some specific hints for 64-bit builds, using them..."
- . ./use64bits.cbu
+: set up shell script to do ~ expansion
+cat >filexp <<EOSS
+$startsh
+: expand filename
+case "\$1" in
+ ~/*|~)
+ echo \$1 | $sed "s|~|\${HOME-\$LOGDIR}|"
+ ;;
+ ~*)
+ if $test -f /bin/csh; then
+ /bin/csh -f -c "glob \$1"
+ failed=\$?
+ echo ""
+ exit \$failed
else
- $cat <<EOM
-(Your platform doesn't have any specific hints for 64-bit builds.
- This is probably okay, especially if your system is a true 64-bit system.)
-EOM
- case "$gccversion" in
- '') ;;
- *) $cat <<EOM
-But since you seem to be using gcc,
-I will now add -DUSE_LONG_LONG to the compilation flags.
-EOM
- ccflags="$ccflags -DUSE_LONG_LONG"
+ name=\`$expr x\$1 : '..\([^/]*\)'\`
+ dir=\`$sed -n -e "/^\${name}:/{s/^[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:\([^:]*\).*"'\$'"/\1/" -e p -e q -e '}' </etc/passwd\`
+ if $test ! -d "\$dir"; then
+ me=\`basename \$0\`
+ echo "\$me: can't locate home directory for: \$name" >&2
+ exit 1
+ fi
+ case "\$1" in
+ */*)
+ echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\`
+ ;;
+ *)
+ echo \$dir
;;
esac
fi
;;
+*)
+ echo \$1
+ ;;
esac
-
-: determine the architecture name
-echo " "
-if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
- tarch=`arch`"-$osname"
-elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then
- if uname -m > tmparch 2>&1 ; then
- tarch=`$sed -e 's/ *$//' -e 's/ /_/g' \
- -e 's/$/'"-$osname/" tmparch`
- else
- tarch="$osname"
- fi
- $rm -f tmparch
-else
- tarch="$osname"
-fi
-case "$myarchname" in
-''|"$tarch") ;;
-*)
- echo "(Your architecture name used to be $myarchname.)"
- archname=''
- ;;
-esac
-myarchname="$tarch"
-case "$archname" in
-'') dflt="$tarch";;
-*) dflt="$archname";;
-esac
-rp='What is your architecture name'
-. ./myread
-archname="$ans"
-case "$usethreads" in
-$define)
- echo "Threads selected." >&4
- case "$archname" in
- *-thread*) echo "...and architecture name already has -thread." >&4
- ;;
- *) archname="$archname-thread"
- echo "...setting architecture name to $archname." >&4
- ;;
- esac
- ;;
-esac
-case "$usemultiplicity" in
-$define)
- echo "Multiplicity selected." >&4
- case "$archname" in
- *-multi*) echo "...and architecture name already has -multi." >&4
- ;;
- *) archname="$archname-multi"
- echo "...setting architecture name to $archname." >&4
- ;;
- esac
- ;;
-esac
-case "$use64bits" in
-$define)
- echo "Explicit 64-bitness selected." >&4
- case "$archname64" in
- '')
- ;;
- *)
- case "$archname" in
- *-$archname64*) echo "...and architecture name already has $archname64." >&4
- ;;
- *) archname="$archname-$archname64"
- echo "...setting architecture name to $archname." >&4
- ;;
- esac
- ;;
- esac
-esac
-
-: decide how portable to be. Allow command line overrides.
-case "$d_portable" in
-"$undef") ;;
-*) d_portable="$define" ;;
-esac
-
-: set up shell script to do ~ expansion
-cat >filexp <<EOSS
-$startsh
-: expand filename
-case "\$1" in
- ~/*|~)
- echo \$1 | $sed "s|~|\${HOME-\$LOGDIR}|"
- ;;
- ~*)
- if $test -f /bin/csh; then
- /bin/csh -f -c "glob \$1"
- failed=\$?
- echo ""
- exit \$failed
- else
- name=\`$expr x\$1 : '..\([^/]*\)'\`
- dir=\`$sed -n -e "/^\${name}:/{s/^[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:\([^:]*\).*"'\$'"/\1/" -e p -e q -e '}' </etc/passwd\`
- if $test ! -d "\$dir"; then
- me=\`basename \$0\`
- echo "\$me: can't locate home directory for: \$name" >&2
- exit 1
- fi
- case "\$1" in
- */*)
- echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\`
- ;;
- *)
- echo \$dir
- ;;
- esac
- fi
- ;;
-*)
- echo \$1
- ;;
-esac
-EOSS
-chmod +x filexp
-$eunicefix filexp
+EOSS
+chmod +x filexp
+$eunicefix filexp
: now set up to get a file name
cat <<EOS >getfile
test "X$gfpthkeep" != Xy && gfpth=""
EOSC
-: determine root of directory hierarchy where package will be installed.
-case "$prefix" in
-'')
- dflt=`./loc . /usr/local /usr/local /local /opt /usr`
+: What should the include directory be ?
+echo " "
+$echo $n "Hmm... $c"
+dflt='/usr/include'
+incpath=''
+mips_type=''
+if $test -f /bin/mips && /bin/mips; then
+ echo "Looks like a MIPS system..."
+ $cat >usr.c <<'EOCP'
+#ifdef SYSTYPE_BSD43
+/bsd43
+#endif
+EOCP
+ if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then
+ dflt='/bsd43/usr/include'
+ incpath='/bsd43'
+ mips_type='BSD 4.3'
+ else
+ mips_type='System V'
+ fi
+ $rm -f usr.c usr.out
+ echo "and you're compiling with the $mips_type compiler and libraries."
+ xxx_prompt=y
+ echo "exit 0" >mips
+else
+ echo "Doesn't look like a MIPS system."
+ xxx_prompt=n
+ echo "exit 1" >mips
+fi
+chmod +x mips
+$eunicefix mips
+case "$usrinc" in
+'') ;;
+*) dflt="$usrinc";;
+esac
+case "$xxx_prompt" in
+y) fn=d/
+ echo " "
+ rp='Where are the include files you want to use?'
+ . ./getfile
+ usrinc="$ans"
;;
-*)
- dflt="$prefix"
+*) usrinc="$dflt"
;;
esac
-$cat <<EOM
-By default, $package will be installed in $dflt/bin, manual pages
-under $dflt/man, etc..., i.e. with $dflt as prefix for all
-installation directories. Typically this is something like /usr/local.
-If you wish to have binaries under /usr/bin but other parts of the
-installation under /usr/local, that's ok: you will be prompted
-separately for each of the installation directories, the prefix being
-only used to set the defaults.
+: Set private lib path
+case "$plibpth" in
+'') if ./mips; then
+ plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
+ fi;;
+esac
+case "$libpth" in
+' ') dlist='';;
+'') dlist="$loclibpth $plibpth $glibpth";;
+*) dlist="$libpth";;
+esac
+
+: Now check and see which directories actually exist, avoiding duplicates
+libpth=''
+for xxx in $dlist
+do
+ if $test -d $xxx; then
+ case " $libpth " in
+ *" $xxx "*) ;;
+ *) libpth="$libpth $xxx";;
+ esac
+ fi
+done
+$cat <<'EOM'
+
+Some systems have incompatible or broken versions of libraries. Among
+the directories listed in the question below, please remove any you
+know not to be holding relevant libraries, and add any that are needed.
+Say "none" for none.
EOM
-fn=d~
-rp='Installation prefix to use?'
-. ./getfile
-oldprefix=''
-case "$prefix" in
-'') ;;
+case "$libpth" in
+'') dflt='none';;
*)
- case "$ans" in
- "$prefix") ;;
- *) oldprefix="$prefix";;
- esac
+ set X $libpth
+ shift
+ dflt=${1+"$@"}
;;
esac
-prefix="$ans"
-prefixexp="$ansexp"
+rp="Directories to use for library searches?"
+. ./myread
+case "$ans" in
+none) libpth=' ';;
+*) libpth="$ans";;
+esac
-: is AFS running?
-echo " "
-case "$afs" in
-$define|true) afs=true ;;
-$undef|false) afs=false ;;
-*) if test -d /afs; then
- afs=true
+: compute shared library extension
+case "$so" in
+'')
+ if xxx=`./loc libc.sl X $libpth`; $test -f "$xxx"; then
+ dflt='sl'
else
- afs=false
+ dflt='so'
fi
;;
+*) dflt="$so";;
esac
-if $afs; then
- echo "AFS may be running... I'll be extra cautious then..." >&4
-else
- echo "AFS does not seem to be running..." >&4
-fi
-
-: determine installation prefix for where package is to be installed.
-if $afs; then
$cat <<EOM
-Since you are running AFS, I need to distinguish the directory in which
-files will reside from the directory in which they are installed (and from
-which they are presumably copied to the former directory by occult means).
+On some systems, shared libraries may be available. Answer 'none' if
+you want to suppress searching of shared libraries for the remaining
+of this configuration.
EOM
- case "$installprefix" in
- '') dflt=`echo $prefix | sed 's#^/afs/#/afs/.#'`;;
- *) dflt="$installprefix";;
- esac
-else
-$cat <<EOM
-
-In some special cases, particularly when building $package for distribution,
-it is convenient to distinguish between the directory in which files should
-be installed from the directory ($prefix) in which they
-will eventually reside. For most users, these two directories are the same.
+rp='What is the file extension used for shared libraries?'
+. ./myread
+so="$ans"
-EOM
- case "$installprefix" in
- '') dflt=$prefix ;;
- *) dflt=$installprefix;;
+: Define several unixisms.
+: Hints files or command line option can be used to override them.
+: The convoluted testing is in case hints files set either the old
+: or the new name.
+case "$_exe" in
+'') case "$exe_ext" in
+ '') ;;
+ *) _exe="$exe_ext" ;;
esac
-fi
-fn=d~
-rp='What installation prefix should I use for installing files?'
-. ./getfile
-installprefix="$ans"
-installprefixexp="$ansexp"
-
-: set the prefixit variable, to compute a suitable default value
-prefixit='case "$3" in
-""|none)
- case "$oldprefix" in
- "") eval "$1=\"\$$2\"";;
- *)
- case "$3" in
- "") eval "$1=";;
- none)
- eval "tp=\"\$$2\"";
- case "$tp" in
- ""|" ") eval "$1=\"\$$2\"";;
- *) eval "$1=";;
- esac;;
- esac;;
- esac;;
-*)
- eval "tp=\"$oldprefix-\$$2-\""; eval "tp=\"$tp\"";
- case "$tp" in
- --|/*--|\~*--) eval "$1=\"$prefix/$3\"";;
- /*-$oldprefix/*|\~*-$oldprefix/*)
- eval "$1=\`echo \$$2 | sed \"s,^$oldprefix,$prefix,\"\`";;
- *) eval "$1=\"\$$2\"";;
- esac;;
-esac'
-
-: set the base revision
-baserev=5.0
-
-: get the patchlevel
-echo " "
-echo "Getting the current patchlevel..." >&4
-if $test -r $rsrc/patchlevel.h;then
- patchlevel=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h`
- subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $rsrc/patchlevel.h`
- apiversion=`awk '/define[ ]+PERL_APIVERSION/ {print $3}' $rsrc/patchlevel.h`
-else
- patchlevel=0
- subversion=0
- apiversion=0
-fi
-$echo $n "(You have $package" $c
-case "$package" in
-"*$baserev") ;;
-*) $echo $n " $baserev" $c ;;
+ ;;
esac
-$echo $n " patchlevel $patchlevel" $c
-test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c
-echo ".)"
-
-if test 0 -eq "$subversion"; then
- version=`LC_ALL=C; export LC_ALL; \
- echo $baserev $patchlevel | \
- $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
-else
- version=`LC_ALL=C; export LC_ALL; \
- echo $baserev $patchlevel $subversion | \
- $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
-fi
-
-: determine installation style
-: For now, try to deduce it from prefix unless it is already set.
-: Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7.
-case "$installstyle" in
-'') case "$prefix" in
- *perl*) dflt='lib';;
- *) dflt='lib/perl5' ;;
+case "$_a" in
+'') case "$lib_ext" in
+ '') _a='.a';;
+ *) _a="$lib_ext" ;;
esac
;;
-*) dflt='lib/perl5' ;;
-esac
-: Probably not worth prompting for this since we prompt for all
-: the directories individually, and the prompt would be too long and
-: confusing anyway.
-installstyle=$dflt
-
-: determine where private library files go
-: Usual default is /usr/local/lib/perl5/$version.
-: Also allow things like /opt/perl/lib/$version, since
-: /opt/perl/lib/perl5... would be redundant.
-: The default "style" setting is made in installstyle.U
-case "$installstyle" in
-*lib/perl5*) set dflt privlib lib/$package/$version ;;
-*) set dflt privlib lib/$version ;;
esac
-eval $prefixit
-$cat <<EOM
-
-There are some auxiliary files for $package that need to be put into a
-private library directory that is accessible by everyone.
-
-EOM
-fn=d~+
-rp='Pathname where the private library files will reside?'
-. ./getfile
-privlib="$ans"
-privlibexp="$ansexp"
-: Change installation prefix, if necessary.
-if $test X"$prefix" != X"$installprefix"; then
- installprivlib=`echo $privlibexp | sed "s#^$prefix#$installprefix#"`
-else
- installprivlib="$privlibexp"
-fi
-
-: set the prefixup variable, to restore leading tilda escape
-prefixup='case "$prefixexp" in
-"$prefix") ;;
-*) eval "$1=\`echo \$$1 | sed \"s,^$prefixexp,$prefix,\"\`";;
-esac'
-
-: determine where public architecture dependent libraries go
-set archlib archlib
-eval $prefixit
-: privlib default is /usr/local/lib/$package/$version
-: archlib default is /usr/local/lib/$package/$version/$archname
-: privlib may have an optional trailing /share.
-tdflt=`echo $privlib | $sed 's,/share$,,'`
-tdflt=$tdflt/$archname
-case "$archlib" in
-'') dflt=$tdflt
+case "$_o" in
+'') case "$obj_ext" in
+ '') _o='.o';;
+ *) _o="$obj_ext";;
+ esac
;;
-*) dflt="$archlib"
- ;;
esac
-$cat <<EOM
-
-$spackage contains architecture-dependent library files. If you are
-sharing libraries in a heterogeneous environment, you might store
-these files in a separate location. Otherwise, you can just include
-them with the rest of the public library files.
-
-EOM
-fn=d+~
-rp='Where do you want to put the public architecture-dependent libraries?'
-. ./getfile
-archlib="$ans"
-archlibexp="$ansexp"
-if $test X"$archlib" = X"$privlib"; then
- d_archlib="$undef"
-else
- d_archlib="$define"
-fi
-: Change installation prefix, if necessary.
-if $test X"$prefix" != X"$installprefix"; then
- installarchlib=`echo $archlibexp | sed "s#^$prefix#$installprefix#"`
-else
- installarchlib="$archlibexp"
-fi
-
-
-: Binary compatibility with 5.005 is not possible for builds
-: with advanced features
-case "$usethreads$usemultiplicity" in
-*define*)
- bincompat5005="$undef"
- d_bincompat5005="$undef"
- ;;
-*) $cat <<EOM
-
-Perl 5.006 can be compiled for binary compatibility with 5.005.
-If you decide to do so, you will be able to continue using most
-of the extensions that were compiled for Perl 5.005.
-
-EOM
- case "$bincompat5005$d_bincompat5005" in
- *"$undef"*) dflt=n ;;
- *) dflt=y ;;
- esac
- rp='Binary compatibility with Perl 5.005?'
- . ./myread
- case "$ans" in
- y*) val="$define" ;;
- *) val="$undef" ;;
- esac
- set d_bincompat5005
- eval $setvar
- case "$d_bincompat5005" in
- "$define")
- bincompat5005="$define"
- ;;
- *) bincompat5005="$undef"
- d_bincompat5005="$undef"
- ;;
+case "$p_" in
+'') case "$path_sep" in
+ '') p_=':';;
+ *) p_="$path_sep";;
esac
;;
esac
+exe_ext=$_exe
+lib_ext=$_a
+obj_ext=$_o
+path_sep=$p_
+: Which makefile gets called first. This is used by make depend.
+case "$firstmakefile" in
+'') firstmakefile='makefile';;
+esac
-: see if setuid scripts can be secure
-$cat <<EOM
+cat <<EOM
-Some kernels have a bug that prevents setuid #! scripts from being
-secure. Some sites have disabled setuid #! scripts because of this.
+Perl can be built to use the SOCKS proxy protocol library. To do so,
+Configure must be run with -Dusesocks.
-First let's decide if your kernel supports secure setuid #! scripts.
-(If setuid #! scripts would be secure but have been disabled anyway,
-don't say that they are secure if asked.)
+Normally you do not need this and you should answer no.
EOM
+case "$usesocks" in
+$define|true|[yY]*) dflt='y';;
+*) dflt='n';;
+esac
+rp='Build Perl for SOCKS?'
+. ./myread
+case "$ans" in
+y|Y) val="$define" ;;
+*) val="$undef" ;;
+esac
+set usesocks
+eval $setvar
-val="$undef"
-if $test -d /dev/fd; then
- echo "#!$ls" >reflect
- chmod +x,u+s reflect
- ./reflect >flect 2>&1
- if $contains "/dev/fd" flect >/dev/null; then
- echo "Congratulations, your kernel has secure setuid scripts!" >&4
- val="$define"
- else
- $cat <<EOM
-If you are not sure if they are secure, I can check but I'll need a
-username and password different from the one you are using right now.
-If you don't have such a username or don't want me to test, simply
-enter 'none'.
-
-EOM
- rp='Other username to test security of setuid scripts with?'
- dflt='none'
- . ./myread
- case "$ans" in
- n|none)
- case "$d_suidsafe" in
- '') echo "I'll assume setuid scripts are *not* secure." >&4
- dflt=n;;
- "$undef")
- echo "Well, the $hint value is *not* secure." >&4
- dflt=n;;
- *) echo "Well, the $hint value *is* secure." >&4
- dflt=y;;
+: Looking for optional libraries
+echo " "
+echo "Checking for optional libraries..." >&4
+case "$libs" in
+' '|'') dflt='';;
+*) dflt="$libs";;
+esac
+case "$libswanted" in
+'') libswanted='c_s';;
+esac
+case "$usesocks" in
+$define)
+ libswanted="$libswanted socks5 socks5_sh"
+ ;;
+esac
+for thislib in $libswanted; do
+
+ if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`;
+ $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then
+ echo "Found -l$thislib (shared)."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l$thislib";;
+ esac
+ elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then
+ echo "Found -l$thislib (shared)."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l$thislib";;
+ esac
+ elif xxx=`./loc lib$thislib$_a X $libpth`; $test -f "$xxx"; then
+ echo "Found -l$thislib."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l$thislib";;
+ esac
+ elif xxx=`./loc $thislib$_a X $libpth`; $test -f "$xxx"; then
+ echo "Found -l$thislib."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l$thislib";;
+ esac
+ elif xxx=`./loc lib${thislib}_s$_a X $libpth`; $test -f "$xxx"; then
+ echo "Found -l${thislib}_s."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l${thislib}_s";;
+ esac
+ elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then
+ echo "Found -l$thislib."
+ case " $dflt " in
+ *"-l$thislib "*);;
+ *) dflt="$dflt -l$thislib";;
+ esac
+ else
+ echo "No -l$thislib."
+ fi
+done
+set X $dflt
+shift
+dflt="$*"
+case "$libs" in
+'') dflt="$dflt";;
+*) dflt="$libs";;
+esac
+case "$dflt" in
+' '|'') dflt='none';;
+esac
+
+$cat <<EOM
+
+In order to compile $package on your machine, a number of libraries
+are usually needed. Include any other special libraries here as well.
+Say "none" for none. The default list is almost always right.
+EOM
+
+echo " "
+rp="What libraries to use?"
+. ./myread
+case "$ans" in
+none) libs=' ';;
+*) libs="$ans";;
+esac
+
+: determine optimization, if desired, or use for debug flag also
+case "$optimize" in
+' '|$undef) dflt='none';;
+'') dflt='-O';;
+*) dflt="$optimize";;
+esac
+$cat <<EOH
+
+By default, $package compiles with the -O flag to use the optimizer.
+Alternately, you might want to use the symbolic debugger, which uses
+the -g flag (on traditional Unix systems). Either flag can be
+specified here. To use neither flag, specify the word "none".
+
+EOH
+rp="What optimizer/debugger flag should be used?"
+. ./myread
+optimize="$ans"
+case "$optimize" in
+'none') optimize=" ";;
+esac
+
+dflt=''
+: We will not override a previous value, but we might want to
+: augment a hint file
+case "$hint" in
+default|recommended)
+ case "$gccversion" in
+ 1*) dflt='-fpcc-struct-return' ;;
+ esac
+ case "$optimize" in
+ *-g*) dflt="$dflt -DDEBUGGING";;
+ esac
+ case "$gccversion" in
+ 2*) if test -d /etc/conf/kconfig.d &&
+ $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
+ then
+ dflt="$dflt -posix"
+ fi
+ ;;
+ esac
+ case "$gccversion" in
+ 1*) ;;
+ 2.[0-8]*) ;;
+ ?*) echo " "
+ echo "Checking if your compiler accepts -fno-strict-aliasing" 2>&1
+ echo 'int main(void) { return 0; }' > gcctest.c
+ if $cc -O2 -fno-strict-aliasing -o gcctest gcctest.c; then
+ echo "Yes, it does." 2>&1
+ case "$ccflags" in
+ *strict-aliasing*)
+ echo "Leaving current flags $ccflags alone." 2>&1
+ ;;
+ *) dflt="$dflt -fno-strict-aliasing" ;;
esac
- ;;
- *)
- $rm -f reflect flect
- echo "#!$ls" >reflect
- chmod +x,u+s reflect
- echo >flect
- chmod a+w flect
- echo '"su" will (probably) prompt you for '"$ans's password."
- su $ans -c './reflect >flect'
- if $contains "/dev/fd" flect >/dev/null; then
- echo "Okay, it looks like setuid scripts are secure." >&4
+ else
+ echo "Nope, it doesn't, but that's ok." 2>&1
+ fi
+ ;;
+ esac
+ ;;
+esac
+
+case "$mips_type" in
+*BSD*|'') inclwanted="$locincpth $usrinc";;
+*) inclwanted="$locincpth $inclwanted $usrinc/bsd";;
+esac
+for thisincl in $inclwanted; do
+ if $test -d $thisincl; then
+ if $test x$thisincl != x$usrinc; then
+ case "$dflt" in
+ *$thisincl*);;
+ *) dflt="$dflt -I$thisincl";;
+ esac
+ fi
+ fi
+done
+
+inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then
+ xxx=true;
+elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then
+ xxx=true;
+else
+ xxx=false;
+fi;
+if $xxx; then
+ case "$dflt" in
+ *$2*);;
+ *) dflt="$dflt -D$2";;
+ esac;
+fi'
+
+set signal.h LANGUAGE_C; eval $inctest
+
+case "$usesocks" in
+$define)
+ ccflags="$ccflags -DSOCKS"
+ ;;
+esac
+
+case "$hint" in
+default|recommended) dflt="$ccflags $dflt" ;;
+*) dflt="$ccflags";;
+esac
+
+case "$dflt" in
+''|' ') dflt=none;;
+esac
+$cat <<EOH
+
+Your C compiler may want other flags. For this question you should include
+-I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
+but you should NOT include libraries or ld flags like -lwhatever. If you
+want $package to honor its debug switch, you should include -DDEBUGGING here.
+Your C compiler might also need additional flags, such as -D_POSIX_SOURCE.
+
+To use no flags, specify the word "none".
+
+EOH
+set X $dflt
+shift
+dflt=${1+"$@"}
+rp="Any additional cc flags?"
+. ./myread
+case "$ans" in
+none) ccflags='';;
+*) ccflags="$ans";;
+esac
+
+: the following weeds options from ccflags that are of no interest to cpp
+cppflags="$ccflags"
+case "$gccversion" in
+1*) cppflags="$cppflags -D__GNUC__"
+esac
+case "$mips_type" in
+'');;
+*BSD*) cppflags="$cppflags -DSYSTYPE_BSD43";;
+esac
+case "$cppflags" in
+'');;
+*)
+ echo " "
+ echo "Let me guess what the preprocessor flags are..." >&4
+ set X $cppflags
+ shift
+ cppflags=''
+ $cat >cpp.c <<'EOM'
+#define BLURFL foo
+
+BLURFL xx LFRULB
+EOM
+ previous=''
+ for flag in $*
+ do
+ case "$flag" in
+ -*) ftry="$flag";;
+ *) ftry="$previous $flag";;
+ esac
+ if $cppstdin -DLFRULB=bar $cppflags $ftry $cppminus <cpp.c \
+ >cpp1.out 2>/dev/null && \
+ $cpprun -DLFRULB=bar $cppflags $ftry $cpplast <cpp.c \
+ >cpp2.out 2>/dev/null && \
+ $contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \
+ $contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1
+ then
+ cppflags="$cppflags $ftry"
+ previous=''
+ else
+ previous="$flag"
+ fi
+ done
+ set X $cppflags
+ shift
+ cppflags=${1+"$@"}
+ case "$cppflags" in
+ *-*) echo "They appear to be: $cppflags";;
+ esac
+ $rm -f cpp.c cpp?.out
+ ;;
+esac
+
+: flags used in final linking phase
+case "$ldflags" in
+'') if ./venix; then
+ dflt='-i -z'
+ else
+ dflt=''
+ fi
+ case "$ccflags" in
+ *-posix*) dflt="$dflt -posix" ;;
+ esac
+ ;;
+*) dflt="$ldflags";;
+esac
+
+: Try to guess additional flags to pick up local libraries.
+for thislibdir in $libpth; do
+ case " $loclibpth " in
+ *" $thislibdir "*)
+ case "$dflt " in
+ *"-L$thislibdir "*) ;;
+ *) dflt="$dflt -L$thislibdir" ;;
+ esac
+ ;;
+ esac
+done
+
+case "$dflt" in
+'') dflt='none' ;;
+esac
+
+$cat <<EOH
+
+Your C linker may need flags. For this question you should
+include -L/whatever and any other flags used by the C linker, but you
+should NOT include libraries like -lwhatever.
+
+Make sure you include the appropriate -L/path flags if your C linker
+does not normally search all of the directories you specified above,
+namely
+ $libpth
+To use no flags, specify the word "none".
+
+EOH
+
+rp="Any additional ld flags (NOT including libraries)?"
+. ./myread
+case "$ans" in
+none) ldflags='';;
+*) ldflags="$ans";;
+esac
+rmlist="$rmlist pdp11"
+
+: coherency check
+echo " "
+echo "Checking your choice of C compiler and flags for coherency..." >&4
+$cat > try.c <<'EOF'
+#include <stdio.h>
+int main() { printf("Ok\n"); exit(0); }
+EOF
+set X $cc $optimize $ccflags -o try $ldflags try.c $libs
+shift
+$cat >try.msg <<'EOM'
+I've tried to compile and run the following simple program:
+
+EOM
+$cat try.c >> try.msg
+
+$cat >> try.msg <<EOM
+
+I used the command:
+
+ $*
+ ./try
+
+and I got the following output:
+
+EOM
+dflt=y
+if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then
+ if sh -c './try' >>try.msg 2>&1; then
+ xxx=`./try`
+ case "$xxx" in
+ "Ok") dflt=n ;;
+ *) echo 'The program compiled OK, but produced no output.' >> try.msg
+ case " $libs " in
+ *" -lsfio "*)
+ cat >> try.msg <<'EOQS'
+If $libs contains -lsfio, and sfio is mis-configured, then it
+sometimes (apparently) runs and exits with a 0 status, but with no
+output! It may have to do with sfio's use of _exit vs. exit.
+
+EOQS
+ rp="You have a big problem. Shall I abort Configure"
dflt=y
- else
- echo "I don't think setuid scripts are secure." >&4
- dflt=n
- fi
+ ;;
+ esac
;;
esac
- rp='Does your kernel have *secure* setuid scripts?'
- . ./myread
- case "$ans" in
- [yY]*) val="$define";;
- *) val="$undef";;
- esac
+ else
+ echo "The program compiled OK, but exited with status $?." >>try.msg
+ rp="You have a problem. Shall I abort Configure"
+ dflt=y
fi
else
- echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4
- echo "(That's for file descriptors, not floppy disks.)"
- val="$undef"
+ echo "I can't compile the test program." >>try.msg
+ rp="You have a BIG problem. Shall I abort Configure"
+ dflt=y
fi
-set d_suidsafe
-eval $setvar
-
-$rm -f reflect flect
-
-: now see if they want to do setuid emulation
-echo " "
-val="$undef"
-case "$d_suidsafe" in
-"$define")
- val="$undef"
- echo "No need to emulate SUID scripts since they are secure here." >& 4
- ;;
-*)
- $cat <<EOM
-Some systems have disabled setuid scripts, especially systems where
-setuid scripts cannot be secure. On systems where setuid scripts have
-been disabled, the setuid/setgid bits on scripts are currently
-useless. It is possible for $package to detect those bits and emulate
-setuid/setgid in a secure fashion. This emulation will only work if
-setuid scripts have been disabled in your kernel.
-
-EOM
- case "$d_dosuid" in
- "$define") dflt=y ;;
- *) dflt=n ;;
+case "$dflt" in
+y)
+ $cat try.msg >&4
+ case "$knowitall" in
+ '')
+ echo "(The supplied flags or libraries might be incorrect.)"
+ ;;
+ *) dflt=n;;
esac
- rp="Do you want to do setuid/setgid emulation?"
+ echo " "
. ./myread
case "$ans" in
- [yY]*) val="$define";;
- *) val="$undef";;
+ n*|N*) ;;
+ *) echo "Ok. Stopping Configure." >&4
+ exit 1
+ ;;
esac
;;
+n) echo "OK, that should do.";;
esac
-set d_dosuid
-eval $setvar
+$rm -f try try.* core
-: What should the include directory be ?
+: define an is-a-typedef? function
+typedef='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
+case "$inclist" in
+"") inclist="sys/types.h";;
+esac;
+eval "varval=\$$var";
+case "$varval" in
+"")
+ $rm -f temp.c;
+ for inc in $inclist; do
+ echo "#include <$inc>" >>temp.c;
+ done;
+ echo "#ifdef $type" >> temp.c;
+ echo "printf(\"We have $type\");" >> temp.c;
+ echo "#endif" >> temp.c;
+ $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
+ if $contains $type temp.E >/dev/null 2>&1; then
+ eval "$var=\$type";
+ else
+ eval "$var=\$def";
+ fi;
+ $rm -f temp.?;;
+*) eval "$var=\$varval";;
+esac'
+
+: define an is-a-typedef? function that prompts if the type is not available.
+typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
+case "$inclist" in
+"") inclist="sys/types.h";;
+esac;
+eval "varval=\$$var";
+case "$varval" in
+"")
+ $rm -f temp.c;
+ for inc in $inclist; do
+ echo "#include <$inc>" >>temp.c;
+ done;
+ echo "#ifdef $type" >> temp.c;
+ echo "printf(\"We have $type\");" >> temp.c;
+ echo "#endif" >> temp.c;
+ $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
+ echo " " ;
+ echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./";
+ if $contains $type temp.E >/dev/null 2>&1; then
+ echo "$type found." >&4;
+ eval "$var=\$type";
+ else
+ echo "$type NOT found." >&4;
+ dflt="$def";
+ . ./myread ;
+ eval "$var=\$ans";
+ fi;
+ $rm -f temp.?;;
+*) eval "$var=\$varval";;
+esac'
+
+: define a shorthand compile call
+compile='
+mc_file=$1;
+shift;
+$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;'
+: define a shorthand compile call for compilations that should be ok.
+compile_ok='
+mc_file=$1;
+shift;
+$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;'
+
+: check for lengths of integral types
echo " "
-$echo $n "Hmm... $c"
-dflt='/usr/include'
-incpath=''
-mips_type=''
-if $test -f /bin/mips && /bin/mips; then
- echo "Looks like a MIPS system..."
- $cat >usr.c <<'EOCP'
-#ifdef SYSTYPE_BSD43
-/bsd43
-#endif
+case "$intsize" in
+'')
+ echo "Checking to see how big your integers are..." >&4
+ $cat >intsize.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("intsize=%d;\n", (int)sizeof(int));
+ printf("longsize=%d;\n", (int)sizeof(long));
+ printf("shortsize=%d;\n", (int)sizeof(short));
+ exit(0);
+}
EOCP
- if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then
- dflt='/bsd43/usr/include'
- incpath='/bsd43'
- mips_type='BSD 4.3'
+ set intsize
+ if eval $compile_ok && ./intsize > /dev/null; then
+ eval `./intsize`
+ echo "Your integers are $intsize bytes long."
+ echo "Your long integers are $longsize bytes long."
+ echo "Your short integers are $shortsize bytes long."
else
- mips_type='System V'
- fi
- $rm -f usr.c usr.out
- echo "and you're compiling with the $mips_type compiler and libraries."
- xxx_prompt=y
- echo "exit 0" >mips
-else
- echo "Doesn't look like a MIPS system."
- xxx_prompt=n
- echo "exit 1" >mips
-fi
-chmod +x mips
-$eunicefix mips
-case "$usrinc" in
-'') ;;
-*) dflt="$usrinc";;
-esac
-case "$xxx_prompt" in
-y) fn=d/
- echo " "
- rp='Where are the include files you want to use?'
- . ./getfile
- usrinc="$ans"
- ;;
-*) usrinc="$dflt"
+ $cat >&4 <<EOM
+!
+Help! I can't compile and run the intsize test program: please enlighten me!
+(This is probably a misconfiguration in your system or libraries, and
+you really ought to fix it. Still, I'll try anyway.)
+!
+EOM
+ dflt=4
+ rp="What is the size of an integer (in bytes)?"
+ . ./myread
+ intsize="$ans"
+ dflt=$intsize
+ rp="What is the size of a long integer (in bytes)?"
+ . ./myread
+ longsize="$ans"
+ dflt=2
+ rp="What is the size of a short integer (in bytes)?"
+ . ./myread
+ shortsize="$ans"
+ fi
;;
esac
+$rm -f intsize intsize.*
+
+: see what type lseek is declared as in the kernel
+rp="What is the type used for lseek's offset on this system?"
+set off_t lseektype long stdio.h sys/types.h
+eval $typedef_ask
-: see how we invoke the C preprocessor
echo " "
-echo "Now, how can we feed standard input to your C preprocessor..." >&4
-cat <<'EOT' >testcpp.c
-#define ABC abc
-#define XYZ xyz
-ABC.XYZ
-EOT
-cd ..
-if test ! -f cppstdin; then
- if test "X$osname" = "Xaix" -a "X$gccversion" = X; then
- # AIX cc -E doesn't show the absolute headerfile
- # locations but we'll cheat by using the -M flag.
- echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin
- else
- echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
- fi
+$echo $n "Checking to see how big your file offsets are...$c" >&4
+$cat >try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", (int)sizeof($lseektype));
+ return(0);
+}
+EOCP
+set try
+if eval $compile_ok; then
+ lseeksize=`./try`
+ $echo " $lseeksize bytes." >&4
else
- echo "Keeping your $hint cppstdin wrapper."
+ dflt=$longsize
+ echo " "
+ echo "(I can't seem to compile the test program. Guessing...)"
+ rp="What is the size of your file offsets (in bytes)?"
+ . ./myread
+ lseeksize="$ans"
fi
-chmod 755 cppstdin
-wrapper=`pwd`/cppstdin
-ok='false'
-cd UU
+$rm -f try.c try
-if $test "X$cppstdin" != "X" && \
- $cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
-then
- echo "You used to use $cppstdin $cppminus so we'll use that again."
- case "$cpprun" in
- '') echo "But let's see if we can live without a wrapper..." ;;
- *)
- if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
- then
- echo "(And we'll use $cpprun $cpplast to preprocess directly.)"
- ok='true'
- else
- echo "(However, $cpprun $cpplast does not work, let's see...)"
- fi
+: see what type file positions are declared as in the library
+rp="What is the type for file position used by fsetpos()?"
+set fpos_t fpostype long stdio.h sys/types.h
+eval $typedef_ask
+
+echo " "
+case "$fpostype" in
+*_t) zzz="$fpostype" ;;
+*) zzz="fpos_t" ;;
+esac
+$echo $n "Checking the size of $zzz...$c" >&4
+cat > try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ printf("%d\n", (int)sizeof($fpostype));
+ exit(0);
+}
+EOCP
+set try
+if eval $compile_ok; then
+ yyy=`./try`
+ case "$yyy" in
+ '') fpossize=4
+ echo " "
+ echo "(I can't execute the test program--guessing $fpossize.)" >&4
;;
- esac
-else
- case "$cppstdin" in
- '') ;;
- *)
- echo "Good old $cppstdin $cppminus does not seem to be of any help..."
+ *) fpossize=$yyy
+ echo " $fpossize bytes."
;;
esac
-fi
-
-if $ok; then
- : nothing
-elif echo 'Maybe "'"$cc"' -E" will work...'; \
- $cc -E <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yup, it does."
- x_cpp="$cc -E"
- x_minus='';
-elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \
- $cc -E - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yup, it does."
- x_cpp="$cc -E"
- x_minus='-';
-elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \
- $cc -P <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Yipee, that works!"
- x_cpp="$cc -P"
- x_minus='';
-elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \
- $cc -P - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "At long last!"
- x_cpp="$cc -P"
- x_minus='-';
-elif echo 'No such luck, maybe "'$cpp'" will work...'; \
- $cpp <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "It works!"
- x_cpp="$cpp"
- x_minus='';
-elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \
- $cpp - <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "Hooray, it works! I was beginning to wonder."
- x_cpp="$cpp"
- x_minus='-';
-elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \
- $wrapper <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- x_cpp="$wrapper"
- x_minus=''
- echo "Eureka!"
else
- dflt=''
- rp="No dice. I can't find a C preprocessor. Name one:"
+ dflt="$longsize"
+ echo " "
+ echo "(I can't compile the test program. Guessing...)" >&4
+ rp="What is the size of your file positions (in bytes)?"
. ./myread
- x_cpp="$ans"
- x_minus=''
- $x_cpp <testcpp.c >testcpp.out 2>&1
- if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
- echo "OK, that will do." >&4
- else
-echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4
- exit 1
- fi
+ fpossize="$ans"
fi
-case "$ok" in
-false)
- cppstdin="$x_cpp"
- cppminus="$x_minus"
- cpprun="$x_cpp"
- cpplast="$x_minus"
- set X $x_cpp
- shift
- case "$1" in
- "$cpp")
- echo "Perhaps can we force $cc -E using a wrapper..."
- if $wrapper <testcpp.c >testcpp.out 2>&1; \
- $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
- then
- echo "Yup, we can."
- cppstdin="$wrapper"
- cppminus='';
+
+
+case "$lseeksize:$fpossize" in
+8:8) cat <<EOM
+
+You can have files larger than 2 gigabytes.
+EOM
+ val="$define" ;;
+*) cat <<EOM
+
+Perl can be built to understand large files (files larger than 2 gigabytes)
+on some systems. To do so, Configure must be run with -Duselargefiles.
+
+If this doesn't make any sense to you, just accept the default 'y'.
+EOM
+ case "$uselargefiles" in
+ "$undef"|false|[nN]*) dflt='n' ;;
+ *) dflt='y' ;;
+ esac
+ rp='Try to understand large files, if available?'
+ . ./myread
+ case "$ans" in
+ y|Y) val="$define" ;;
+ *) val="$undef" ;;
+ esac
+ ;;
+esac
+set uselargefiles
+eval $setvar
+case "$uselargefiles" in
+"$define")
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that a large files perl is to be built,
+: we may need to set or change some other defaults.
+ if $test -f uselfs.cbu; then
+ echo "Your platform has some specific hints for large file builds, using them..."
+ . ./uselfs.cbu
+ echo " "
+ $echo $n "Rechecking to see how big your file offsets are...$c" >&4
+ $cat >try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", (int)sizeof($lseektype));
+ return(0);
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ lseeksize=`./try`
+ $echo " $lseeksize bytes." >&4
else
- echo "Nope, we'll have to live without it..."
+ dflt="$lseeksize"
+ echo " "
+ echo "(I can't seem to compile the test program. Guessing...)"
+ rp="What is the size of your file offsets (in bytes)?"
+ . ./myread
+ lseeksize="$ans"
fi
- ;;
- esac
- case "$cpprun" in
- "$wrapper")
- cpprun=''
- cpplast=''
- ;;
- esac
+ case "$fpostype" in
+ *_t) zzz="$fpostype" ;;
+ *) zzz="fpos_t" ;;
+ esac
+ $echo $n "Rechecking the size of $zzz...$c" >&4
+ $cat > try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ printf("%d\n", (int)sizeof($fpostype));
+ exit(0);
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ yyy=`./try`
+ dflt="$lseeksize"
+ case "$yyy" in
+ '') echo " "
+ echo "(I can't execute the test program--guessing $fpossize.)" >&4
+ ;;
+ *) fpossize=$yyy
+ echo " $fpossize bytes."
+ ;;
+ esac
+ else
+ dflt="$fpossize"
+ echo " "
+ echo "(I can't compile the test program. Guessing...)" >&4
+ rp="What is the size of your file positions (in bytes)?"
+ . ./myread
+ fpossize="$ans"
+ fi
+ $rm -f try.c try
+ fi
;;
esac
-case "$cppstdin" in
-"$wrapper"|'cppstdin') ;;
-*) $rm -f $wrapper;;
-esac
-$rm -f testcpp.c testcpp.out
-
-: Set private lib path
-case "$plibpth" in
-'') if ./mips; then
- plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
- fi;;
-esac
-case "$libpth" in
-' ') dlist='';;
-'') dlist="$loclibpth $plibpth $glibpth";;
-*) dlist="$libpth";;
-esac
-: Now check and see which directories actually exist, avoiding duplicates
-libpth=''
-for xxx in $dlist
-do
- if $test -d $xxx; then
- case " $libpth " in
- *" $xxx "*) ;;
- *) libpth="$libpth $xxx";;
- esac
- fi
-done
-$cat <<'EOM'
+case "$usemorebits" in
+"$define"|true|[yY]*)
+ use64bits="$define"
+ uselongdouble="$define"
+ usemorebits="$define"
+ ;;
+*) usemorebits="$undef"
+ ;;
+esac
-Some systems have incompatible or broken versions of libraries. Among
-the directories listed in the question below, please remove any you
-know not to be holding relevant libraries, and add any that are needed.
-Say "none" for none.
+case "$intsize:$longsize" in
+8:*|*:8) cat <<EOM
+
+You have natively 64-bit integers.
EOM
-case "$libpth" in
-'') dflt='none';;
-*)
- set X $libpth
- shift
- dflt=${1+"$@"}
- ;;
+ val="$define" ;;
+*) cat <<EOM
+
+Perl can be built to take advantage of 64-bit integer types
+on some systems. To do so, Configure must be run with -Duse64bits.
+
+If this doesn't make any sense to you, just accept the default.
+EOM
+ case "$use64bits" in
+ $define|true|[yY]*) dflt='y';;
+ *) dflt='n';;
+ esac
+ rp='Try to use 64-bit integers, if available?'
+ . ./myread
+ case "$ans" in
+ y|Y) val="$define" ;;
+ *) val="$undef" ;;
+ esac
+ ;;
esac
-rp="Directories to use for library searches?"
-. ./myread
-case "$ans" in
-none) libpth=' ';;
-*) libpth="$ans";;
+set use64bits
+eval $setvar
+
+case "$archname64" in
+'') archname64='' ;; # not a typo
esac
-: compute shared library extension
-case "$so" in
-'')
- if xxx=`./loc libc.sl X $libpth`; $test -f "$xxx"; then
- dflt='sl'
+case "$use64bits" in
+"$define"|true|[yY]*)
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that a 64-bit perl is to be built,
+: we may need to set or change some other defaults.
+ if $test -f use64bits.cbu; then
+ echo "Your platform has some specific hints for 64-bit builds, using them..."
+ . ./use64bits.cbu
else
- dflt='so'
+ $cat <<EOM
+(Your platform doesn't have any specific hints for 64-bit builds.)
+EOM
+ case "$intsize:$longsize" in
+8:*|*:8) cat <<EOM
+(This is probably okay, as your system is a natively 64-bit system.)
+EOM
+ ;;
+ esac
+ case "$gccversion" in
+ '') ;;
+ *) case "$ccflags" in
+ *-DUSE_LONG_LONG*) ;;
+ *) $cat <<EOM
+But since you seem to be using gcc, I will now add -DUSE_LONG_LONG
+to the compilation flags.
+EOM
+ ccflags="$ccflags -DUSE_LONG_LONG"
+ ;;
+ esac
+ ;;
+ esac
fi
;;
-*) dflt="$so";;
esac
-$cat <<EOM
-
-On some systems, shared libraries may be available. Answer 'none' if
-you want to suppress searching of shared libraries for the remaining
-of this configuration.
-
-EOM
-rp='What is the file extension used for shared libraries?'
-. ./myread
-so="$ans"
-: Define several unixisms.
-: Hints files or command line option can be used to override them.
-: The convoluted testing is in case hints files set either the old
-: or the new name.
-case "$_exe" in
-'') case "$exe_ext" in
- '') ;;
- *) _exe="$exe_ext" ;;
- esac
+: determine the architecture name
+echo " "
+if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
+ tarch=`arch`"-$osname"
+elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then
+ if uname -m > tmparch 2>&1 ; then
+ tarch=`$sed -e 's/ *$//' -e 's/ /_/g' \
+ -e 's/$/'"-$osname/" tmparch`
+ else
+ tarch="$osname"
+ fi
+ $rm -f tmparch
+else
+ tarch="$osname"
+fi
+case "$myarchname" in
+''|"$tarch") ;;
+*)
+ echo "(Your architecture name used to be $myarchname.)"
+ archname=''
;;
esac
-case "$_a" in
-'') case "$lib_ext" in
- '') _a='.a';;
- *) _a="$lib_ext" ;;
- esac
+myarchname="$tarch"
+case "$archname" in
+'') dflt="$tarch";;
+*) dflt="$archname";;
+esac
+rp='What is your architecture name'
+. ./myread
+archname="$ans"
+case "$usethreads" in
+$define)
+ echo "Threads selected." >&4
+ case "$archname" in
+ *-thread*) echo "...and architecture name already has -thread." >&4
+ ;;
+ *) archname="$archname-thread"
+ echo "...setting architecture name to $archname." >&4
+ ;;
+ esac
;;
esac
-case "$_o" in
-'') case "$obj_ext" in
- '') _o='.o';;
- *) _o="$obj_ext";;
- esac
+case "$usemultiplicity" in
+$define)
+ echo "Multiplicity selected." >&4
+ case "$archname" in
+ *-multi*) echo "...and architecture name already has -multi." >&4
+ ;;
+ *) archname="$archname-multi"
+ echo "...setting architecture name to $archname." >&4
+ ;;
+ esac
;;
esac
-case "$p_" in
-'') case "$path_sep" in
- '') p_=':';;
- *) p_="$path_sep";;
+case "$use64bits" in
+$define)
+ case "$archname64" in
+ '')
+ ;;
+ *)
+ case "$archname" in
+ *-$archname64*) echo "...and architecture name already has $archname64." >&4
+ ;;
+ *) archname="$archname-$archname64"
+ echo "...setting architecture name to $archname." >&4
+ ;;
+ esac
+ ;;
esac
- ;;
esac
-exe_ext=$_exe
-lib_ext=$_a
-obj_ext=$_o
-path_sep=$p_
-: Which makefile gets called first. This is used by make depend.
-case "$firstmakefile" in
-'') firstmakefile='makefile';;
+: determine root of directory hierarchy where package will be installed.
+case "$prefix" in
+'')
+ dflt=`./loc . /usr/local /usr/local /local /opt /usr`
+ ;;
+*)
+ dflt="$prefix"
+ ;;
esac
+$cat <<EOM
-cat <<EOM
-
-Perl can be built to use the SOCKS proxy protocol library. To do so,
-Configure must be run with -Dusesocks.
-
-Normally you do not need this and you should answer no.
+By default, $package will be installed in $dflt/bin, manual pages
+under $dflt/man, etc..., i.e. with $dflt as prefix for all
+installation directories. Typically this is something like /usr/local.
+If you wish to have binaries under /usr/bin but other parts of the
+installation under /usr/local, that's ok: you will be prompted
+separately for each of the installation directories, the prefix being
+only used to set the defaults.
EOM
-case "$usesocks" in
-$define|true|[yY]*) dflt='y';;
-*) dflt='n';;
-esac
-rp='Build Perl for SOCKS?'
-. ./myread
-case "$ans" in
-y|Y) val="$define" ;;
-*) val="$undef" ;;
-esac
-set usesocks
-eval $setvar
-
-: Looking for optional libraries
-echo " "
-echo "Checking for optional libraries..." >&4
-case "$libs" in
-' '|'') dflt='';;
-*) dflt="$libs";;
-esac
-case "$libswanted" in
-'') libswanted='c_s';;
-esac
-case "$usesocks" in
-$define)
- libswanted="$libswanted socks5 socks5_sh"
- ;;
-esac
-for thislib in $libswanted; do
-
- if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`;
- $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then
- echo "Found -l$thislib (shared)."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
- elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then
- echo "Found -l$thislib (shared)."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
- elif xxx=`./loc lib$thislib$_a X $libpth`; $test -f "$xxx"; then
- echo "Found -l$thislib."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
- elif xxx=`./loc $thislib$_a X $libpth`; $test -f "$xxx"; then
- echo "Found -l$thislib."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
- elif xxx=`./loc lib${thislib}_s$_a X $libpth`; $test -f "$xxx"; then
- echo "Found -l${thislib}_s."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l${thislib}_s";;
- esac
- elif xxx=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$xxx"; then
- echo "Found -l$thislib."
- case " $dflt " in
- *"-l$thislib "*);;
- *) dflt="$dflt -l$thislib";;
- esac
+fn=d~
+rp='Installation prefix to use?'
+. ./getfile
+oldprefix=''
+case "$prefix" in
+'') ;;
+*)
+ case "$ans" in
+ "$prefix") ;;
+ *) oldprefix="$prefix";;
+ esac
+ ;;
+esac
+prefix="$ans"
+prefixexp="$ansexp"
+
+: is AFS running?
+echo " "
+case "$afs" in
+$define|true) afs=true ;;
+$undef|false) afs=false ;;
+*) if test -d /afs; then
+ afs=true
else
- echo "No -l$thislib."
+ afs=false
fi
-done
-set X $dflt
-shift
-dflt="$*"
-case "$libs" in
-'') dflt="$dflt";;
-*) dflt="$libs";;
-esac
-case "$dflt" in
-' '|'') dflt='none';;
+ ;;
esac
+if $afs; then
+ echo "AFS may be running... I'll be extra cautious then..." >&4
+else
+ echo "AFS does not seem to be running..." >&4
+fi
+: determine installation prefix for where package is to be installed.
+if $afs; then
$cat <<EOM
-In order to compile $package on your machine, a number of libraries
-are usually needed. Include any other special libraries here as well.
-Say "none" for none. The default list is almost always right.
+Since you are running AFS, I need to distinguish the directory in which
+files will reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
EOM
+ case "$installprefix" in
+ '') dflt=`echo $prefix | sed 's#^/afs/#/afs/.#'`;;
+ *) dflt="$installprefix";;
+ esac
+else
+$cat <<EOM
-echo " "
-rp="What libraries to use?"
-. ./myread
-case "$ans" in
-none) libs=' ';;
-*) libs="$ans";;
-esac
+In some special cases, particularly when building $package for distribution,
+it is convenient to distinguish between the directory in which files should
+be installed from the directory ($prefix) in which they
+will eventually reside. For most users, these two directories are the same.
-: determine optimization, if desired, or use for debug flag also
-case "$optimize" in
-' '|$undef) dflt='none';;
-'') dflt='-O';;
-*) dflt="$optimize";;
-esac
-$cat <<EOH
+EOM
+ case "$installprefix" in
+ '') dflt=$prefix ;;
+ *) dflt=$installprefix;;
+ esac
+fi
+fn=d~
+rp='What installation prefix should I use for installing files?'
+. ./getfile
+installprefix="$ans"
+installprefixexp="$ansexp"
-By default, $package compiles with the -O flag to use the optimizer.
-Alternately, you might want to use the symbolic debugger, which uses
-the -g flag (on traditional Unix systems). Either flag can be
-specified here. To use neither flag, specify the word "none".
+: set the prefixit variable, to compute a suitable default value
+prefixit='case "$3" in
+""|none)
+ case "$oldprefix" in
+ "") eval "$1=\"\$$2\"";;
+ *)
+ case "$3" in
+ "") eval "$1=";;
+ none)
+ eval "tp=\"\$$2\"";
+ case "$tp" in
+ ""|" ") eval "$1=\"\$$2\"";;
+ *) eval "$1=";;
+ esac;;
+ esac;;
+ esac;;
+*)
+ eval "tp=\"$oldprefix-\$$2-\""; eval "tp=\"$tp\"";
+ case "$tp" in
+ --|/*--|\~*--) eval "$1=\"$prefix/$3\"";;
+ /*-$oldprefix/*|\~*-$oldprefix/*)
+ eval "$1=\`echo \$$2 | sed \"s,^$oldprefix,$prefix,\"\`";;
+ *) eval "$1=\"\$$2\"";;
+ esac;;
+esac'
-EOH
-rp="What optimizer/debugger flag should be used?"
-. ./myread
-optimize="$ans"
-case "$optimize" in
-'none') optimize=" ";;
+: set the base revision
+baserev=5.0
+
+: get the patchlevel
+echo " "
+echo "Getting the current patchlevel..." >&4
+if $test -r $rsrc/patchlevel.h;then
+ patchlevel=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h`
+ subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $rsrc/patchlevel.h`
+ apiversion=`awk '/define[ ]+PERL_APIVERSION/ {print $3}' $rsrc/patchlevel.h`
+else
+ patchlevel=0
+ subversion=0
+ apiversion=0
+fi
+$echo $n "(You have $package" $c
+case "$package" in
+"*$baserev") ;;
+*) $echo $n " $baserev" $c ;;
esac
+$echo $n " patchlevel $patchlevel" $c
+test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c
+echo ".)"
-dflt=''
-: We will not override a previous value, but we might want to
-: augment a hint file
-case "$hint" in
-default|recommended)
- case "$gccversion" in
- 1*) dflt='-fpcc-struct-return' ;;
- esac
- case "$optimize" in
- *-g*) dflt="$dflt -DDEBUGGING";;
- esac
- case "$gccversion" in
- 2*) if test -d /etc/conf/kconfig.d &&
- $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
- then
- dflt="$dflt -posix"
- fi
- ;;
- esac
- case "$gccversion" in
- 1*) ;;
- 2.[0-8]*) ;;
- ?*) echo " "
- echo "Checking if your compiler accepts -fno-strict-aliasing" 2>&1
- echo 'int main(void) { return 0; }' > gcctest.c
- if $cc -O2 -fno-strict-aliasing -o gcctest gcctest.c; then
- echo "Yes, it does." 2>&1
- case "$ccflags" in
- *strict-aliasing*)
- echo "Leaving current flags $ccflags alone." 2>&1
- ;;
- *) dflt="$dflt -fno-strict-aliasing" ;;
- esac
- else
- echo "Nope, it doesn't, but that's ok." 2>&1
- fi
- ;;
+if test 0 -eq "$subversion"; then
+ version=`LC_ALL=C; export LC_ALL; \
+ echo $baserev $patchlevel | \
+ $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
+else
+ version=`LC_ALL=C; export LC_ALL; \
+ echo $baserev $patchlevel $subversion | \
+ $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
+fi
+
+: determine installation style
+: For now, try to deduce it from prefix unless it is already set.
+: Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7.
+case "$installstyle" in
+'') case "$prefix" in
+ *perl*) dflt='lib';;
+ *) dflt='lib/perl5' ;;
esac
;;
+*) dflt='lib/perl5' ;;
esac
+: Probably not worth prompting for this since we prompt for all
+: the directories individually, and the prompt would be too long and
+: confusing anyway.
+installstyle=$dflt
-case "$mips_type" in
-*BSD*|'') inclwanted="$locincpth $usrinc";;
-*) inclwanted="$locincpth $inclwanted $usrinc/bsd";;
+: determine where private library files go
+: Usual default is /usr/local/lib/perl5/$version.
+: Also allow things like /opt/perl/lib/$version, since
+: /opt/perl/lib/perl5... would be redundant.
+: The default "style" setting is made in installstyle.U
+case "$installstyle" in
+*lib/perl5*) set dflt privlib lib/$package/$version ;;
+*) set dflt privlib lib/$version ;;
esac
-for thisincl in $inclwanted; do
- if $test -d $thisincl; then
- if $test x$thisincl != x$usrinc; then
- case "$dflt" in
- *$thisincl*);;
- *) dflt="$dflt -I$thisincl";;
- esac
- fi
- fi
-done
+eval $prefixit
+$cat <<EOM
-inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then
- xxx=true;
-elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then
- xxx=true;
+There are some auxiliary files for $package that need to be put into a
+private library directory that is accessible by everyone.
+
+EOM
+fn=d~+
+rp='Pathname where the private library files will reside?'
+. ./getfile
+privlib="$ans"
+privlibexp="$ansexp"
+: Change installation prefix, if necessary.
+if $test X"$prefix" != X"$installprefix"; then
+ installprivlib=`echo $privlibexp | sed "s#^$prefix#$installprefix#"`
else
- xxx=false;
-fi;
-if $xxx; then
- case "$dflt" in
- *$2*);;
- *) dflt="$dflt -D$2";;
- esac;
-fi'
+ installprivlib="$privlibexp"
+fi
-set signal.h LANGUAGE_C; eval $inctest
+: set the prefixup variable, to restore leading tilda escape
+prefixup='case "$prefixexp" in
+"$prefix") ;;
+*) eval "$1=\`echo \$$1 | sed \"s,^$prefixexp,$prefix,\"\`";;
+esac'
-case "$usesocks" in
-$define)
- ccflags="$ccflags -DSOCKS"
+: determine where public architecture dependent libraries go
+set archlib archlib
+eval $prefixit
+: privlib default is /usr/local/lib/$package/$version
+: archlib default is /usr/local/lib/$package/$version/$archname
+: privlib may have an optional trailing /share.
+tdflt=`echo $privlib | $sed 's,/share$,,'`
+tdflt=$tdflt/$archname
+case "$archlib" in
+'') dflt=$tdflt
;;
+*) dflt="$archlib"
+ ;;
esac
+$cat <<EOM
-case "$hint" in
-default|recommended) dflt="$ccflags $dflt" ;;
-*) dflt="$ccflags";;
-esac
-
-case "$dflt" in
-''|' ') dflt=none;;
-esac
-$cat <<EOH
+$spackage contains architecture-dependent library files. If you are
+sharing libraries in a heterogeneous environment, you might store
+these files in a separate location. Otherwise, you can just include
+them with the rest of the public library files.
-Your C compiler may want other flags. For this question you should include
--I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
-but you should NOT include libraries or ld flags like -lwhatever. If you
-want $package to honor its debug switch, you should include -DDEBUGGING here.
-Your C compiler might also need additional flags, such as -D_POSIX_SOURCE.
+EOM
+fn=d+~
+rp='Where do you want to put the public architecture-dependent libraries?'
+. ./getfile
+archlib="$ans"
+archlibexp="$ansexp"
+if $test X"$archlib" = X"$privlib"; then
+ d_archlib="$undef"
+else
+ d_archlib="$define"
+fi
+: Change installation prefix, if necessary.
+if $test X"$prefix" != X"$installprefix"; then
+ installarchlib=`echo $archlibexp | sed "s#^$prefix#$installprefix#"`
+else
+ installarchlib="$archlibexp"
+fi
-To use no flags, specify the word "none".
-EOH
-set X $dflt
-shift
-dflt=${1+"$@"}
-rp="Any additional cc flags?"
-. ./myread
-case "$ans" in
-none) ccflags='';;
-*) ccflags="$ans";;
-esac
+: Binary compatibility with 5.005 is not possible for builds
+: with advanced features
+case "$usethreads$usemultiplicity" in
+*define*)
+ bincompat5005="$undef"
+ d_bincompat5005="$undef"
+ ;;
+*) $cat <<EOM
-: the following weeds options from ccflags that are of no interest to cpp
-cppflags="$ccflags"
-case "$gccversion" in
-1*) cppflags="$cppflags -D__GNUC__"
-esac
-case "$mips_type" in
-'');;
-*BSD*) cppflags="$cppflags -DSYSTYPE_BSD43";;
-esac
-case "$cppflags" in
-'');;
-*)
- echo " "
- echo "Let me guess what the preprocessor flags are..." >&4
- set X $cppflags
- shift
- cppflags=''
- $cat >cpp.c <<'EOM'
-#define BLURFL foo
+Perl 5.006 can be compiled for binary compatibility with 5.005.
+If you decide to do so, you will be able to continue using most
+of the extensions that were compiled for Perl 5.005.
-BLURFL xx LFRULB
EOM
- previous=''
- for flag in $*
- do
- case "$flag" in
- -*) ftry="$flag";;
- *) ftry="$previous $flag";;
- esac
- if $cppstdin -DLFRULB=bar $cppflags $ftry $cppminus <cpp.c \
- >cpp1.out 2>/dev/null && \
- $cpprun -DLFRULB=bar $cppflags $ftry $cpplast <cpp.c \
- >cpp2.out 2>/dev/null && \
- $contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \
- $contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1
- then
- cppflags="$cppflags $ftry"
- previous=''
- else
- previous="$flag"
- fi
- done
- set X $cppflags
- shift
- cppflags=${1+"$@"}
- case "$cppflags" in
- *-*) echo "They appear to be: $cppflags";;
+ case "$bincompat5005$d_bincompat5005" in
+ *"$undef"*) dflt=n ;;
+ *) dflt=y ;;
esac
- $rm -f cpp.c cpp?.out
- ;;
-esac
-
-: flags used in final linking phase
-case "$ldflags" in
-'') if ./venix; then
- dflt='-i -z'
- else
- dflt=''
- fi
- case "$ccflags" in
- *-posix*) dflt="$dflt -posix" ;;
+ rp='Binary compatibility with Perl 5.005?'
+ . ./myread
+ case "$ans" in
+ y*) val="$define" ;;
+ *) val="$undef" ;;
esac
- ;;
-*) dflt="$ldflags";;
-esac
-
-: Try to guess additional flags to pick up local libraries.
-for thislibdir in $libpth; do
- case " $loclibpth " in
- *" $thislibdir "*)
- case "$dflt " in
- *"-L$thislibdir "*) ;;
- *) dflt="$dflt -L$thislibdir" ;;
- esac
+ set d_bincompat5005
+ eval $setvar
+ case "$d_bincompat5005" in
+ "$define")
+ bincompat5005="$define"
+ ;;
+ *) bincompat5005="$undef"
+ d_bincompat5005="$undef"
;;
esac
-done
-
-case "$dflt" in
-'') dflt='none' ;;
+ ;;
esac
-$cat <<EOH
-
-Your C linker may need flags. For this question you should
-include -L/whatever and any other flags used by the C linker, but you
-should NOT include libraries like -lwhatever.
-
-Make sure you include the appropriate -L/path flags if your C linker
-does not normally search all of the directories you specified above,
-namely
- $libpth
-To use no flags, specify the word "none".
-EOH
+: see if setuid scripts can be secure
+$cat <<EOM
-rp="Any additional ld flags (NOT including libraries)?"
-. ./myread
-case "$ans" in
-none) ldflags='';;
-*) ldflags="$ans";;
-esac
-rmlist="$rmlist pdp11"
+Some kernels have a bug that prevents setuid #! scripts from being
+secure. Some sites have disabled setuid #! scripts because of this.
-: coherency check
-echo " "
-echo "Checking your choice of C compiler and flags for coherency..." >&4
-$cat > try.c <<'EOF'
-#include <stdio.h>
-int main() { printf("Ok\n"); exit(0); }
-EOF
-set X $cc $optimize $ccflags -o try $ldflags try.c $libs
-shift
-$cat >try.msg <<'EOM'
-I've tried to compile and run the following simple program:
+First let's decide if your kernel supports secure setuid #! scripts.
+(If setuid #! scripts would be secure but have been disabled anyway,
+don't say that they are secure if asked.)
EOM
-$cat try.c >> try.msg
-$cat >> try.msg <<EOM
-
-I used the command:
-
- $*
- ./try
-
-and I got the following output:
+val="$undef"
+if $test -d /dev/fd; then
+ echo "#!$ls" >reflect
+ chmod +x,u+s reflect
+ ./reflect >flect 2>&1
+ if $contains "/dev/fd" flect >/dev/null; then
+ echo "Congratulations, your kernel has secure setuid scripts!" >&4
+ val="$define"
+ else
+ $cat <<EOM
+If you are not sure if they are secure, I can check but I'll need a
+username and password different from the one you are using right now.
+If you don't have such a username or don't want me to test, simply
+enter 'none'.
EOM
-dflt=y
-if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then
- if sh -c './try' >>try.msg 2>&1; then
- xxx=`./try`
- case "$xxx" in
- "Ok") dflt=n ;;
- *) echo 'The program compiled OK, but produced no output.' >> try.msg
- case " $libs " in
- *" -lsfio "*)
- cat >> try.msg <<'EOQS'
-If $libs contains -lsfio, and sfio is mis-configured, then it
-sometimes (apparently) runs and exits with a 0 status, but with no
-output! It may have to do with sfio's use of _exit vs. exit.
-
-EOQS
- rp="You have a big problem. Shall I abort Configure"
- dflt=y
- ;;
+ rp='Other username to test security of setuid scripts with?'
+ dflt='none'
+ . ./myread
+ case "$ans" in
+ n|none)
+ case "$d_suidsafe" in
+ '') echo "I'll assume setuid scripts are *not* secure." >&4
+ dflt=n;;
+ "$undef")
+ echo "Well, the $hint value is *not* secure." >&4
+ dflt=n;;
+ *) echo "Well, the $hint value *is* secure." >&4
+ dflt=y;;
esac
;;
+ *)
+ $rm -f reflect flect
+ echo "#!$ls" >reflect
+ chmod +x,u+s reflect
+ echo >flect
+ chmod a+w flect
+ echo '"su" will (probably) prompt you for '"$ans's password."
+ su $ans -c './reflect >flect'
+ if $contains "/dev/fd" flect >/dev/null; then
+ echo "Okay, it looks like setuid scripts are secure." >&4
+ dflt=y
+ else
+ echo "I don't think setuid scripts are secure." >&4
+ dflt=n
+ fi
+ ;;
+ esac
+ rp='Does your kernel have *secure* setuid scripts?'
+ . ./myread
+ case "$ans" in
+ [yY]*) val="$define";;
+ *) val="$undef";;
esac
- else
- echo "The program compiled OK, but exited with status $?." >>try.msg
- rp="You have a problem. Shall I abort Configure"
- dflt=y
fi
else
- echo "I can't compile the test program." >>try.msg
- rp="You have a BIG problem. Shall I abort Configure"
- dflt=y
+ echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4
+ echo "(That's for file descriptors, not floppy disks.)"
+ val="$undef"
fi
-case "$dflt" in
-y)
- $cat try.msg >&4
- case "$knowitall" in
- '')
- echo "(The supplied flags or libraries might be incorrect.)"
- ;;
- *) dflt=n;;
+set d_suidsafe
+eval $setvar
+
+$rm -f reflect flect
+
+: now see if they want to do setuid emulation
+echo " "
+val="$undef"
+case "$d_suidsafe" in
+"$define")
+ val="$undef"
+ echo "No need to emulate SUID scripts since they are secure here." >& 4
+ ;;
+*)
+ $cat <<EOM
+Some systems have disabled setuid scripts, especially systems where
+setuid scripts cannot be secure. On systems where setuid scripts have
+been disabled, the setuid/setgid bits on scripts are currently
+useless. It is possible for $package to detect those bits and emulate
+setuid/setgid in a secure fashion. This emulation will only work if
+setuid scripts have been disabled in your kernel.
+
+EOM
+ case "$d_dosuid" in
+ "$define") dflt=y ;;
+ *) dflt=n ;;
esac
- echo " "
+ rp="Do you want to do setuid/setgid emulation?"
. ./myread
case "$ans" in
- n*|N*) ;;
- *) echo "Ok. Stopping Configure." >&4
- exit 1
- ;;
+ [yY]*) val="$define";;
+ *) val="$undef";;
esac
;;
-n) echo "OK, that should do.";;
esac
-$rm -f try try.* core
+set d_dosuid
+eval $setvar
: determine filename position in cpp output
echo " "
set installusrbinperl
eval $setvar
-: define a shorthand compile call
-compile='
-mc_file=$1;
-shift;
-$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;'
-: define a shorthand compile call for compilations that should be ok.
-compile_ok='
-mc_file=$1;
-shift;
-$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;'
-
echo " "
echo "Checking for GNU C Library..." >&4
cat >gnulibc.c <<EOM
installsitearch="$sitearchexp"
fi
+: determine where add-on public executables go
+case "$sitebin" in
+'') dflt=$siteprefix/bin ;;
+*) dflt=$sitebin ;;
+esac
+fn=d~
+rp='Pathname where the add-on public executables should be installed?'
+. ./getfile
+sitebin="$ans"
+sitebinexp="$ansexp"
+: Change installation prefix, if necessary.
+if $test X"$prefix" != X"$installprefix"; then
+ installsitebin=`echo $sitebinexp | sed "s#^$prefix#$installprefix#"`
+else
+ installsitebin="$sitebinexp"
+fi
+
cat <<EOM
Perl can be built to take advantage of long doubles which
-(if available) may give more accuracy and range for floating point
-numbers. To do so, Configure must be run with -Duselongdouble.
+(if available) may give more accuracy and range for floating point numbers.
If this doesn't make any sense to you, just accept the default 'n'.
EOM
+
+case "$ccflags" in
+*-DUSE_LONG_DOUBLE*|*-DUSE_MORE_BITS*) uselongdouble="$define" ;;
+esac
+
case "$uselongdouble" in
$define|true|[yY]*) dflt='y';;
*) dflt='n';;
eval $setvar
case "$uselongdouble" in
-"$define"|true|[yY]*)
+true|[yY]*) uselongdouble="$define" ;;
+esac
+
+case "$uselongdouble" in
+$define)
: Look for a hint-file generated 'call-back-unit'. If the
: user has specified that long doubles should be used,
: we may need to set or change some other defaults.
cat <<EOM
-Previous version of $package used the standard IO mechanisms as defined
-in <stdio.h>. Versions 5.003_02 and later of perl allow alternate IO
-mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still
-the default. This abstraction layer can use AT&T's sfio (if you already
-have sfio installed) or regular stdio. Using PerlIO with sfio may cause
-problems with some extension modules. Using PerlIO with stdio is safe,
-but it is slower than plain stdio and therefore is not the default.
-
-If this doesn't make any sense to you, just accept the default 'n'.
-EOM
-case "$useperlio" in
-$define|true|[yY]*) dflt='y';;
-*) dflt='n';;
-esac
-rp='Use the experimental PerlIO abstraction layer?'
-. ./myread
-case "$ans" in
-y|Y)
- val="$define"
- ;;
-*)
- echo "Ok, doing things the stdio way"
- val="$undef"
- ;;
-esac
-set useperlio
-eval $setvar
-
-: Check how to convert floats to strings.
-if test "X$d_Gconvert" = X; then
- echo " "
- echo "Checking for an efficient way to convert floats to strings."
- $cat >try.c <<'EOP'
-#ifdef TRY_gconvert
-#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
-char *myname = "gconvert";
-#endif
-#ifdef TRY_gcvt
-#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
-char *myname = "gcvt";
-#endif
-#ifdef TRY_sprintf
-#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
-char *myname = "sprintf";
-#endif
-
-#include <stdio.h>
-
-int
-checkit(expect, got)
-char *expect;
-char *got;
-{
- if (strcmp(expect, got)) {
- printf("%s oddity: Expected %s, got %s\n",
- myname, expect, got);
- exit(1);
- }
-}
-
-int main()
-{
- char buf[64];
- buf[63] = '\0';
-
- /* This must be 1st test on (which?) platform */
- /* Alan Burlison <AlanBurlsin@unn.unisys.com> */
- Gconvert(0.1, 8, 0, buf);
- checkit("0.1", buf);
-
- Gconvert(1.0, 8, 0, buf);
- checkit("1", buf);
-
- Gconvert(0.0, 8, 0, buf);
- checkit("0", buf);
-
- Gconvert(-1.0, 8, 0, buf);
- checkit("-1", buf);
-
- /* Some Linux gcvt's give 1.e+5 here. */
- Gconvert(100000.0, 8, 0, buf);
- checkit("100000", buf);
-
- /* Some Linux gcvt's give -1.e+5 here. */
- Gconvert(-100000.0, 8, 0, buf);
- checkit("-100000", buf);
-
- exit(0);
-}
-EOP
- case "$d_Gconvert" in
- gconvert*) xxx_list='gconvert gcvt sprintf' ;;
- gcvt*) xxx_list='gcvt gconvert sprintf' ;;
- sprintf*) xxx_list='sprintf gconvert gcvt' ;;
- *) xxx_list='gconvert gcvt sprintf' ;;
- esac
-
- for xxx_convert in $xxx_list; do
- echo "Trying $xxx_convert"
- $rm -f try try$_o
- set try -DTRY_$xxx_convert
- if eval $compile; then
- echo "$xxx_convert" found. >&4
- if ./try; then
- echo "I'll use $xxx_convert to convert floats into a string." >&4
- break;
- else
- echo "...But $xxx_convert didn't work as I expected."
- fi
- else
- echo "$xxx_convert NOT found." >&4
- fi
- done
-
- case "$xxx_convert" in
- gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
- gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
- *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
- esac
-fi
-
-: see if inttypes.h is available
-: we want a real compile instead of Inhdr because some systems
-: have an inttypes.h which includes non-existent headers
-echo " "
-$cat >try.c <<EOCP
-#include <inttypes.h>
-int main() {
- static int32_t foo32 = 0x12345678;
-}
-EOCP
-set try
-if eval $compile; then
- echo "<inttypes.h> found." >&4
- val="$define"
-else
- echo "<inttypes.h> NOT found." >&4
- val="$undef"
-fi
-$rm -f try.c try
-set i_inttypes
-eval $setvar
-
-: check for int64_t
-case "$use64bits" in
-"$define" )
- echo " "
- $echo $n "Checking to see if your system supports int64_t...$c" >&4
- $cat >try.c <<EOCP
-#include <sys/types.h>
-#$i_inttypes I_INTTYPES
-#ifdef I_INTTYPES
-#include <inttypes.h>
-#endif
-int64_t foo() { int64_t x; x = 7; return x; }
-EOCP
- if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
- val="$define"
- echo " Yup, it does." >&4
- else
- val="$undef"
- echo " Nope, it doesn't." >&4
- fi
- $rm -f try.*
- ;;
-*) val="$undef"
- ;;
+Perl can be built to take advantage of long longs which
+(if available) may give more range for integer numbers.
+
+If this doesn't make any sense to you, just accept the default 'n'.
+EOM
+
+case "$ccflags" in
+*-DUSE_LONG_LONG*) uselonglong="$define" ;;
esac
-set d_int64t
+
+case "$uselonglong" in
+$define|true|[yY]*) dflt='y';;
+*) dflt='n';;
+esac
+rp='Try to use long longs if available?'
+. ./myread
+case "$ans" in
+y|Y) val="$define" ;;
+*) val="$undef" ;;
+esac
+set uselonglong
eval $setvar
+case "$uselonglong" in
+true|[yY]*) uselonglong="$define" ;;
+esac
-: check for lengths of integral types
-echo " "
-case "$intsize" in
-'')
- echo "Checking to see how big your integers are..." >&4
- $cat >intsize.c <<'EOCP'
-#include <stdio.h>
-int main()
-{
- printf("intsize=%d;\n", sizeof(int));
- printf("longsize=%d;\n", sizeof(long));
- printf("shortsize=%d;\n", sizeof(short));
- exit(0);
-}
-EOCP
- set intsize
- if eval $compile_ok && ./intsize > /dev/null; then
- eval `./intsize`
- echo "Your integers are $intsize bytes long."
- echo "Your long integers are $longsize bytes long."
- echo "Your short integers are $shortsize bytes long."
+case "$uselonglong" in
+$define)
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that long longs should be used,
+: we may need to set or change some other defaults.
+ if $test -f uselonglong.cbu; then
+ echo "Your platform has some specific hints for long longs, using them..."
+ . ./uselonglong.cbu
else
- $cat >&4 <<EOM
-!
-Help! I can't compile and run the intsize test program: please enlighten me!
-(This is probably a misconfiguration in your system or libraries, and
-you really ought to fix it. Still, I'll try anyway.)
-!
+ $cat <<EOM
+(Your platform doesn't have any specific hints for long longs.)
EOM
- dflt=4
- rp="What is the size of an integer (in bytes)?"
- . ./myread
- intsize="$ans"
- dflt=$intsize
- rp="What is the size of a long integer (in bytes)?"
- . ./myread
- longsize="$ans"
- dflt=2
- rp="What is the size of a short integer (in bytes)?"
- . ./myread
- shortsize="$ans"
fi
;;
esac
-$rm -f intsize intsize.*
-: check for long long
-echo " "
-$echo $n "Checking to see if your system supports long long...$c" >&4
-echo 'long long foo() { long long x; x = 7; return x; }' > try.c
-if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+cat <<EOM
+
+Previous version of $package used the standard IO mechanisms as defined
+in <stdio.h>. Versions 5.003_02 and later of perl allow alternate IO
+mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still
+the default. This abstraction layer can use AT&T's sfio (if you already
+have sfio installed) or regular stdio. Using PerlIO with sfio may cause
+problems with some extension modules. Using PerlIO with stdio is safe,
+but it is slower than plain stdio and therefore is not the default.
+
+If this doesn't make any sense to you, just accept the default 'n'.
+EOM
+case "$useperlio" in
+$define|true|[yY]*) dflt='y';;
+*) dflt='n';;
+esac
+rp='Use the experimental PerlIO abstraction layer?'
+. ./myread
+case "$ans" in
+y|Y)
val="$define"
- echo " Yup, it does." >&4
-else
+ ;;
+*)
+ echo "Ok, doing things the stdio way"
val="$undef"
- echo " Nope, it doesn't." >&4
-fi
-$rm try.*
-set d_longlong
-eval $setvar
+ ;;
+esac
+set useperlio
+eval $setvar
-: check for length of long long
-case "${d_longlong}${longlongsize}" in
-$define)
- echo " "
- $echo $n "Checking to see how big your long longs are...$c" >&4
- $cat >try.c <<'EOCP'
-#include <stdio.h>
-int main()
-{
- printf("%d\n", sizeof(long long));
-}
-EOCP
- set try
- if eval $compile_ok; then
- longlongsize=`./try`
- $echo " $longlongsize bytes." >&4
+case "$vendorprefix" in
+'') d_vendorbin="$undef"
+ vendorbin=''
+ vendorbinexp=''
+ ;;
+*) d_vendorbin="$define"
+ : determine where vendor-supplied executables go.
+ dflt=$vendorprefix/bin
+ fn=d~+
+ rp='Pathname for the vendor-supplied executables directory?'
+ . ./getfile
+ vendorbin="$ans"
+ vendorbinexp="$ansexp"
+ : Change installation prefix, if necessary.
+ if $test X"$prefix" != X"$installprefix"; then
+ installvendorbin=`echo $vendorbinexp | $sed "s#^$prefix#$installprefix#"`
else
- dflt='8'
- echo " "
- echo "(I can't seem to compile the test program. Guessing...)"
- rp="What is the size of a long long (in bytes)?"
- . ./myread
- longlongsize="$ans"
+ installvendorbin="$vendorbinexp"
fi
- if $test "X$longsize" = "X$longlongsize"; then
- echo "(That isn't any different from an ordinary long.)"
- fi
;;
esac
-$rm -f try.c try
-echo " "
-
-if $test X"$intsize" = X8 -o X"$longsize" = X8 -o X"$d_int64t" = X"$define" -o X"$d_longlong" = X"$define"; then
-
-echo "Checking how to print 64-bit integers..." >&4
+: Check how to convert floats to strings.
+if test "X$d_Gconvert" = X; then
+ echo " "
+ echo "Checking for an efficient way to convert floats to strings."
+ $cat >try.c <<'EOP'
+#ifdef TRY_gconvert
+#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
+char *myname = "gconvert";
+#endif
+#ifdef TRY_gcvt
+#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
+char *myname = "gcvt";
+#endif
+#ifdef TRY_sprintf
+#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+char *myname = "sprintf";
+#endif
-if $test X"$sPRId64" = X -a X"$intsize" = X8; then
- quad=int
- $cat >try.c <<'EOCP'
-#include <sys/types.h>
#include <stdio.h>
-int main() {
- int q = 12345678901;
- printf("%ld\n", q);
-}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"';
- sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"';
- echo "We will use %d."
- ;;
- esac
- fi
-fi
-if $test X"$sPRId64" = X -a X"$longsize" = X8; then
- quad=long
- $cat >try.c <<'EOCP'
-#include <sys/types.h>
-#include <stdio.h>
-int main() {
- long q = 12345678901;
- printf("%ld\n", q);
+int
+checkit(expect, got)
+char *expect;
+char *got;
+{
+ if (strcmp(expect, got)) {
+ printf("%s oddity: Expected %s, got %s\n",
+ myname, expect, got);
+ exit(1);
+ }
}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"';
- sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"';
- echo "We will use %ld."
- ;;
- esac
- fi
-fi
-if $test X"$sPRId64" = X -a X"$i_inttypes.h" = X"$define" -a X"$d_int64t" = X"$define"; then
- quad=int64_t
- $cat >try.c <<'EOCP'
-#include <sys/types.h>
-#include <inttypes.h>
-#include <stdio.h>
-int main() {
- int64_t q = 12345678901;
- printf("%" PRId64 "\n", q);
-}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64;
- sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64;
- echo "We will use the C9X style."
- ;;
- esac
- fi
-fi
+int main()
+{
+ char buf[64];
+ buf[63] = '\0';
-if $test X"$sPRId64" = X -a X"$d_longlong" = X"$define" -a X"$longlongsize" = X8; then
- quad="long long"
- $cat >try.c <<'EOCP'
-#include <sys/types.h>
-#include <stdio.h>
-int main() {
- long long q = 12345678901LL; /* AIX cc requires the LL prefix. */
- printf("%lld\n", q);
-}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"';
- sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"';
- echo "We will use the %lld style."
- ;;
- esac
- fi
-fi
+ /* This must be 1st test on (which?) platform */
+ /* Alan Burlison <AlanBurlsin@unn.unisys.com> */
+ Gconvert(0.1, 8, 0, buf);
+ checkit("0.1", buf);
-if $test X"$sPRId64" = X -a X"$quad" != X; then
- $cat >try.c <<EOCP
-#include <sys/types.h>
-#include <stdio.h>
-int main() {
- $quad q = 12345678901;
- printf("%Ld\n", q);
-}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"';
- sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"';
- echo "We will use %lld."
- ;;
- esac
- fi
-fi
+ Gconvert(1.0, 8, 0, buf);
+ checkit("1", buf);
-if $test X"$sPRId64" = X -a X"$quad" != X; then
- $cat >try.c <<EOCP
-#include <sys/types.h>
-#include <stdio.h>
-int main() {
- $quad q = 12345678901;
- printf("%qd\n", q);
-}
-EOCP
- set try
- if eval $compile; then
- yyy=`./try$exe_ext`
- case "$yyy" in
- 12345678901)
- sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"';
- sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"';
- echo "We will use %qd."
- ;;
- esac
- fi
-fi
+ Gconvert(0.0, 8, 0, buf);
+ checkit("0", buf);
-if $test X"$sPRId64" = X; then
- echo "Cannot figure out how to print 64-bit integers." >&4
-fi
+ Gconvert(-1.0, 8, 0, buf);
+ checkit("-1", buf);
-$rm -f try try.*
+ /* Some Linux gcvt's give 1.e+5 here. */
+ Gconvert(100000.0, 8, 0, buf);
+ checkit("100000", buf);
+
+ /* Some Linux gcvt's give -1.e+5 here. */
+ Gconvert(-100000.0, 8, 0, buf);
+ checkit("-100000", buf);
-fi # intsize -o longsize -o d_int64t -o d_longlong
+ exit(0);
+}
+EOP
+ case "$d_Gconvert" in
+ gconvert*) xxx_list='gconvert gcvt sprintf' ;;
+ gcvt*) xxx_list='gcvt gconvert sprintf' ;;
+ sprintf*) xxx_list='sprintf gconvert gcvt' ;;
+ *) xxx_list='gconvert gcvt sprintf' ;;
+ esac
-case "$sPRId64" in
-'') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef";
- d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef";
- ;;
-*) d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define";
- d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define";
- ;;
-esac
+ for xxx_convert in $xxx_list; do
+ echo "Trying $xxx_convert"
+ $rm -f try try$_o
+ set try -DTRY_$xxx_convert
+ if eval $compile; then
+ echo "$xxx_convert" found. >&4
+ if ./try; then
+ echo "I'll use $xxx_convert to convert floats into a string." >&4
+ break;
+ else
+ echo "...But $xxx_convert didn't work as I expected."
+ fi
+ else
+ echo "$xxx_convert NOT found." >&4
+ fi
+ done
+
+ case "$xxx_convert" in
+ gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
+ gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
+ *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
+ esac
+fi
: check for length of double
echo " "
#include <stdio.h>
int main()
{
- printf("%d\n", sizeof(double));
+ printf("%d\n", (int)sizeof(double));
+ exit(0);
}
EOCP
set try
: check for long doubles
echo " "
-$echo $n "Checking to see if your system supports long double...$c" >&4
-echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c
-if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+$echo $n "Checking to see if your system supports long double..." $c >&4
+echo 'int main() { long double x = 7.0; }' > try.c
+set try
+if eval $compile; then
val="$define"
- echo " Yup, it does." >&4
+ echo " Yes, it does." >&4
else
val="$undef"
- echo " Nope, it doesn't." >&4
+ echo " No, it doesn't." >&4
fi
$rm try.*
set d_longdbl
case "${d_longdbl}${longdblsize}" in
$define)
echo " "
- $echo $n "Checking to see how big your long doubles are...$c" >&4
+ $echo $n "Checking to see how big your long doubles are..." $c >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
int main()
}
EOCP
set try
+ set try
if eval $compile; then
- longdblsize=`./try`
+ longdblsize=`./try$exe_ext`
$echo " $longdblsize bytes." >&4
else
dflt='8'
fi
;;
esac
-$rm -f try.c try
+$rm -f try.* try
echo " "
along = (unsigned long)f;
if (along != 0x7fffffff)
result |= 1;
- f += 2.;
- along = 0;
- along = (unsigned long)f;
- if (along != 0x80000001)
- result |= 2;
- if (result)
- exit(result);
- signal(SIGFPE, blech_in_list);
- sprintf(str, "123.");
- sscanf(str, "%lf", &f); /* f = 123.; */
- along = dummy_long((unsigned long)f);
- aint = dummy_int((unsigned int)f);
- ashort = dummy_short((unsigned short)f);
- if (along != (unsigned long)123)
- result |= 4;
- if (aint != (unsigned int)123)
- result |= 4;
- if (ashort != (unsigned short)123)
- result |= 4;
- exit(result);
-
-}
-EOCP
-set try
-if eval $compile_ok; then
- ./try
- castflags=$?
-else
- echo "(I can't seem to compile the test program--assuming it can't)"
- castflags=7
-fi
-case "$castflags" in
-0) val="$define"
- echo "Yup, it can."
- ;;
-*) val="$undef"
- echo "Nope, it can't."
- ;;
-esac
-set d_castneg
-eval $setvar
-$rm -f try.*
-
-: see if vprintf exists
-echo " "
-if set vprintf val -f d_vprintf; eval $csym; $val; then
- echo 'vprintf() found.' >&4
- val="$define"
- $cat >vprintf.c <<'EOF'
-#include <varargs.h>
-
-int main() { xxx("foo"); }
-
-xxx(va_alist)
-va_dcl
-{
- va_list args;
- char buf[10];
-
- va_start(args);
- exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
-}
-EOF
- set vprintf
- if eval $compile && ./vprintf; then
- echo "Your vsprintf() returns (int)." >&4
- val2="$undef"
- else
- echo "Your vsprintf() returns (char*)." >&4
- val2="$define"
- fi
-else
- echo 'vprintf() NOT found.' >&4
- val="$undef"
- val2="$undef"
-fi
-set d_vprintf
-eval $setvar
-val=$val2
-set d_charvspr
-eval $setvar
-
-: see if chown exists
-set chown d_chown
-eval $inlibc
-
-: see if chroot exists
-set chroot d_chroot
-eval $inlibc
-
-: see if chsize exists
-set chsize d_chsize
-eval $inlibc
-
-hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift;
-while $test $# -ge 2; do
- case "$1" in
- $define) echo "#include <$2>";;
- esac ;
- shift 2;
-done > try.c;
-echo "int main () { struct $struct foo; foo.$field = 0; }" >> try.c;
-if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
- val="$define";
-else
- val="$undef";
-fi;
-set $varname;
-eval $setvar;
-$rm -f try.c try.o'
-
-: see if this is a sys/uio.h system
-set sys/uio.h i_sysuio
-eval $inhdr
-
-echo "Checking to see if your system supports struct iovec..." >&4
-set d_iovec_s iovec iov_base $i_sysuio sys/uio.h
-eval $hasfield
-case "$d_iovec_s" in
-"$define") echo "Yup, it does." >&4
- ;;
-*) echo "Nope, it doesn't." >&4
- ;;
-esac
-
-socketlib=''
-sockethdr=''
-: see whether socket exists
-echo " "
-$echo $n "Hmm... $c" >&4
-if set socket val -f d_socket; eval $csym; $val; then
- echo "Looks like you have Berkeley networking support." >&4
- d_socket="$define"
- if set setsockopt val -f; eval $csym; $val; then
- d_oldsock="$undef"
- else
- echo "...but it uses the old BSD 4.1c interface, rather than 4.2." >&4
- d_oldsock="$define"
- fi
-else
- if $contains socklib libc.list >/dev/null 2>&1; then
- echo "Looks like you have Berkeley networking support." >&4
- d_socket="$define"
- : we will have to assume that it supports the 4.2 BSD interface
- d_oldsock="$undef"
- else
- echo "You don't have Berkeley networking in libc$_a..." >&4
- if test "X$d_socket" = "X$define"; then
- echo "...but you seem to believe that you have sockets." >&4
- else
- for net in net socket
- do
- if test -f /usr/lib/lib$net$_a; then
- ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \
- $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list
- if $contains socket libc.list >/dev/null 2>&1; then
- d_socket="$define"
- socketlib="-l$net"
- case "$net" in
- net)
- echo "...but the Wollongong group seems to have hacked it in." >&4
- sockethdr="-I/usr/netinclude"
- ;;
- esac
- echo "Found Berkeley sockets interface in lib$net." >& 4
- if $contains setsockopt libc.list >/dev/null 2>&1; then
- d_oldsock="$undef"
- else
- echo "...using the old BSD 4.1c interface, rather than 4.2." >&4
- d_oldsock="$define"
- fi
- break
- fi
- fi
- done
- if test "X$d_socket" != "X$define"; then
- echo "or anywhere else I see." >&4
- d_socket="$undef"
- d_oldsock="$undef"
- fi
- fi
- fi
+ f += 2.;
+ along = 0;
+ along = (unsigned long)f;
+ if (along != 0x80000001)
+ result |= 2;
+ if (result)
+ exit(result);
+ signal(SIGFPE, blech_in_list);
+ sprintf(str, "123.");
+ sscanf(str, "%lf", &f); /* f = 123.; */
+ along = dummy_long((unsigned long)f);
+ aint = dummy_int((unsigned int)f);
+ ashort = dummy_short((unsigned short)f);
+ if (along != (unsigned long)123)
+ result |= 4;
+ if (aint != (unsigned int)123)
+ result |= 4;
+ if (ashort != (unsigned short)123)
+ result |= 4;
+ exit(result);
+
+}
+EOCP
+set try
+if eval $compile_ok; then
+ ./try
+ castflags=$?
+else
+ echo "(I can't seem to compile the test program--assuming it can't)"
+ castflags=7
fi
+case "$castflags" in
+0) val="$define"
+ echo "Yup, it can."
+ ;;
+*) val="$undef"
+ echo "Nope, it can't."
+ ;;
+esac
+set d_castneg
+eval $setvar
+$rm -f try.*
-: see if socketpair exists
-set socketpair d_sockpair
-eval $inlibc
+: see if vprintf exists
+echo " "
+if set vprintf val -f d_vprintf; eval $csym; $val; then
+ echo 'vprintf() found.' >&4
+ val="$define"
+ $cat >vprintf.c <<'EOF'
+#include <varargs.h>
+int main() { xxx("foo"); }
-echo " "
-echo "Checking the availability of certain socket constants..." >& 4
-for ENUM in MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS; do
- enum=`$echo $ENUM|./tr '[A-Z]' '[a-z]'`
- $cat >try.c <<EOF
-#include <sys/types.h>
-#include <sys/socket.h>
-int main() {
- int i = $ENUM;
+xxx(va_alist)
+va_dcl
+{
+ va_list args;
+ char buf[10];
+
+ va_start(args);
+ exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
}
EOF
- val="$undef"
- set try; if eval $compile; then
- val="$define"
+ set vprintf
+ if eval $compile && ./vprintf; then
+ echo "Your vsprintf() returns (int)." >&4
+ val2="$undef"
+ else
+ echo "Your vsprintf() returns (char*)." >&4
+ val2="$define"
fi
- set d_${enum}; eval $setvar
- $rm -f try.c try
-done
+else
+ echo 'vprintf() NOT found.' >&4
+ val="$undef"
+ val2="$undef"
+fi
+set d_vprintf
+eval $setvar
+val=$val2
+set d_charvspr
+eval $setvar
-set sendmsg d_sendmsg
+: see if chown exists
+set chown d_chown
eval $inlibc
-set recvmsg d_recvmsg
+: see if chroot exists
+set chroot d_chroot
eval $inlibc
-echo " "
-$echo $n "Checking to see if your system supports struct msghdr...$c" >&4
-set d_msghdr_s msghdr msg_name define sys/types.h $d_socket sys/socket.h $i_sysuio sys/uio.h
-eval $hasfield
-case "$d_msghdr_s" in
-"$define") echo "Yup, it does." >&4
- ;;
-*) echo "Nope, it doesn't." >&4
- ;;
-esac
-
-$echo $n "Checking to see if your system supports struct cmsghdr...$c" >&4
-set d_cmsghdr_s cmsghdr cmsg_len define sys/types.h $d_socket sys/socket.h $i_sysuio sys/uio.h
-eval $hasfield
-case "$d_cmsghdr_s" in
-"$define") echo "Yup, it does." >&4
- ;;
-*) echo "Nope, it doesn't." >&4
- ;;
-esac
+: see if chsize exists
+set chsize d_chsize
+eval $inlibc
: check for const keyword
echo " "
eval $setvar
$rm -f open3*
+: see which of string.h or strings.h is needed
+echo " "
+strings=`./findhdr string.h`
+if $test "$strings" && $test -r "$strings"; then
+ echo "Using <string.h> instead of <strings.h>." >&4
+ val="$define"
+else
+ val="$undef"
+ strings=`./findhdr strings.h`
+ if $test "$strings" && $test -r "$strings"; then
+ echo "Using <strings.h> instead of <string.h>." >&4
+ else
+ echo "No string header found -- You'll surely have problems." >&4
+ fi
+fi
+set i_string
+eval $setvar
+case "$i_string" in
+"$undef") strings=`./findhdr strings.h`;;
+*) strings=`./findhdr string.h`;;
+esac
+
: check for non-blocking I/O stuff
case "$h_sysfile" in
true) echo "#include <sys/file.h>" > head.c;;
'')
$cat head.c > try.c
$cat >>try.c <<'EOCP'
+#include <stdio.h>
int main() {
#ifdef O_NONBLOCK
printf("O_NONBLOCK\n");
#include <errno.h>
#include <sys/types.h>
#include <signal.h>
+#include <stdio.h>
#define MY_O_NONBLOCK $o_nonblock
#ifndef errno /* XXX need better Configure test */
extern int errno;
#endif
+#$i_unistd I_UNISTD
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+#ifdef $i_string
+#include <string.h>
+#else
+#include <strings.h>
+#endif
$signal_t blech(x) int x; { exit(3); }
EOCP
$cat >> try.c <<'EOCP'
set fcntl d_fcntl
eval $inlibc
+hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift;
+while $test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>";;
+ esac ;
+ shift 2;
+done > try.c;
+echo "int main () { struct $struct foo; char* bar; bar = (char*)foo.$field; }" >> try.c;
+set try;
+if eval $compile; then
+ val="$define";
+else
+ val="$undef";
+fi;
+set $varname;
+eval $setvar;
+$rm -f try.c try.o'
+
+socketlib=''
+sockethdr=''
+: see whether socket exists
+echo " "
+$echo $n "Hmm... $c" >&4
+if set socket val -f d_socket; eval $csym; $val; then
+ echo "Looks like you have Berkeley networking support." >&4
+ d_socket="$define"
+ if set setsockopt val -f; eval $csym; $val; then
+ d_oldsock="$undef"
+ else
+ echo "...but it uses the old BSD 4.1c interface, rather than 4.2." >&4
+ d_oldsock="$define"
+ fi
+else
+ if $contains socklib libc.list >/dev/null 2>&1; then
+ echo "Looks like you have Berkeley networking support." >&4
+ d_socket="$define"
+ : we will have to assume that it supports the 4.2 BSD interface
+ d_oldsock="$undef"
+ else
+ echo "You don't have Berkeley networking in libc$_a..." >&4
+ if test "X$d_socket" = "X$define"; then
+ echo "...but you seem to believe that you have sockets." >&4
+ else
+ for net in net socket
+ do
+ if test -f /usr/lib/lib$net$_a; then
+ ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \
+ $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list
+ if $contains socket libc.list >/dev/null 2>&1; then
+ d_socket="$define"
+ socketlib="-l$net"
+ case "$net" in
+ net)
+ echo "...but the Wollongong group seems to have hacked it in." >&4
+ sockethdr="-I/usr/netinclude"
+ ;;
+ esac
+ echo "Found Berkeley sockets interface in lib$net." >& 4
+ if $contains setsockopt libc.list >/dev/null 2>&1; then
+ d_oldsock="$undef"
+ else
+ echo "...using the old BSD 4.1c interface, rather than 4.2." >&4
+ d_oldsock="$define"
+ fi
+ break
+ fi
+ fi
+ done
+ if test "X$d_socket" != "X$define"; then
+ echo "or anywhere else I see." >&4
+ d_socket="$undef"
+ d_oldsock="$undef"
+ fi
+ fi
+ fi
+fi
+
+: see if socketpair exists
+set socketpair d_sockpair
+eval $inlibc
+
+
+echo " "
+echo "Checking the availability of certain socket constants..." >& 4
+for ENUM in MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS; do
+ enum=`$echo $ENUM|./tr '[A-Z]' '[a-z]'`
+ $cat >try.c <<EOF
+#include <sys/types.h>
+#include <sys/socket.h>
+int main() {
+ int i = $ENUM;
+}
+EOF
+ val="$undef"
+ set try; if eval $compile; then
+ val="$define"
+ fi
+ set d_${enum}; eval $setvar
+ $rm -f try.c try
+done
+
: see if sys/select.h has to be included
set sys/select.h i_sysselct
eval $inhdr
eval $inlibc
-: see if llseek exists
-set llseek d_llseek
-eval $inlibc
-
: check for off64_t
echo " "
-$echo $n "Checking to see if your system supports off64_t...$c" >&4
+echo "Checking to see if your system supports off64_t..." >&4
$cat >try.c <<EOCP
#include <sys/types.h>
#include <unistd.h>
-off64_t foo() { off64_t x; x = 7; return x; }'
+int main() { off64_t x = 7; }'
EOCP
-if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+set try
+if eval $compile; then
val="$define"
- echo " Yup, it does." >&4
+ echo "Yes, it does."
else
val="$undef"
- echo " Nope, it doesn't." >&4
+ echo "No, it doesn't."
+ case "$lseeksize" in
+ 8) echo "(Your off_t is 64 bits, so you could use that.)" ;;
+ esac
fi
-$rm -f try.*
+$rm -f try.* try
set d_off64_t
eval $setvar
: check for fpos64_t
echo " "
-$echo $n "Checking to see if your system supports fpos64_t...$c" >&4
+echo "Checking to see if your system supports fpos64_t..." >&4
$cat >try.c <<EOCP
#include <sys/stdio.h>
-fpos64_t foo() { fpos64_t x; x = 7; return x; }'
+int main() { fpos64_t x x = 7; }'
EOCP
-if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+set try
+if eval $compile; then
val="$define"
- echo " Yup, it does." >&4
+ echo "Yes, it does."
else
val="$undef"
- echo " Nope, it doesn't." >&4
+ echo "No, it doesn't."
+ case "$fpossize" in
+ 8) echo "(Your fpos_t is 64 bits, so you could use that.)" ;;
+ esac
fi
-$rm -f try.*
+$rm -f try.* try
set d_fpos64_t
eval $setvar
-: see if fseeko exists
-set fseeko d_fseeko
-eval $inlibc
-
-: see if fsetpos exists
-set fsetpos d_fsetpos
-eval $inlibc
+hasstruct='varname=$1; struct=$2; shift; shift;
+while $test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>";;
+ esac ;
+ shift 2;
+done > try.c;
+echo "int main () { struct $struct foo; }" >> try.c;
+set try;
+if eval $compile; then
+ val="$define";
+else
+ val="$undef";
+fi;
+set $varname;
+eval $setvar;
+$rm -f try.c try.o'
: see if this is a sys/param system
set sys/param.h i_sysparam
set sys/mount.h i_sysmount
eval $inhdr
+: see if sys/types.h has to be included
+set sys/types.h i_systypes
+eval $inhdr
+
-: see if statfs exists
-set statfs d_statfs
+echo " "
+echo "Checking to see if your system supports struct fs_data..." >&4
+set d_fs_data_s fs_data $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h
+eval $hasstruct
+case "$d_fs_data_s" in
+"$define") echo "Yes, it does." ;;
+*) echo "No, it doesn't." ;;
+esac
+
+: see if fseeko exists
+set fseeko d_fseeko
+eval $inlibc
+case "$longsize" in
+8) echo "(Your long is 64 bits, so in a pinch you could use fseek.)" ;;
+esac
+
+: see if fsetpos exists
+set fsetpos d_fsetpos
eval $inlibc
+
: see if fstatfs exists
set fstatfs d_fstatfs
eval $inlibc
-: see if statfs knows about mount flags
-set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h
-eval $hasfield
-
: see if statvfs exists
set statvfs d_statvfs
: see if ftello exists
set ftello d_ftello
eval $inlibc
+case "$longsize" in
+8) echo "(Your long is 64 bits, so in a pinch you could use ftell.)" ;;
+esac
: see if getgrent exists
set getgrent d_getgrent
set getlogin d_getlogin
eval $inlibc
+: see if getmnt exists
+set getmnt d_getmnt
+eval $inlibc
+
: see if getmntent exists
set getmntent d_getmntent
eval $inlibc
set d_htonl
eval $setvar
-: see which of string.h or strings.h is needed
-echo " "
-strings=`./findhdr string.h`
-if $test "$strings" && $test -r "$strings"; then
- echo "Using <string.h> instead of <strings.h>." >&4
- val="$define"
-else
- val="$undef"
- strings=`./findhdr strings.h`
- if $test "$strings" && $test -r "$strings"; then
- echo "Using <strings.h> instead of <string.h>." >&4
- else
- echo "No string header found -- You'll surely have problems." >&4
- fi
-fi
-set i_string
-eval $setvar
-case "$i_string" in
-"$undef") strings=`./findhdr strings.h`;;
-*) strings=`./findhdr string.h`;;
-esac
-
: index or strchr
echo " "
if set index val -f; eval $csym; $val; then
set inet_aton d_inetaton
eval $inlibc
+: see if inttypes.h is available
+: we want a real compile instead of Inhdr because some systems
+: have an inttypes.h which includes non-existent headers
+echo " "
+$cat >try.c <<EOCP
+#include <inttypes.h>
+int main() {
+ static int32_t foo32 = 0x12345678;
+}
+EOCP
+set try
+if eval $compile; then
+ echo "<inttypes.h> found." >&4
+ val="$define"
+else
+ echo "<inttypes.h> NOT found." >&4
+ val="$undef"
+fi
+$rm -f try.c try
+set i_inttypes
+eval $setvar
+
+: check for int64_t
+echo " "
+$echo $n "Checking to see if your system supports int64_t...$c" >&4
+$cat >try.c <<EOCP
+#include <sys/types.h>
+#$i_inttypes I_INTTYPES
+#ifdef I_INTTYPES
+#include <inttypes.h>
+#endif
+int main() { int64_t x = 7; }
+EOCP
+set try
+if eval $compile; then
+ val="$define"
+ echo " Yes, it does." >&4
+else
+ val="$undef"
+ echo " No, it doesn't." >&4
+fi
+$rm -f try try.*
+set d_int64t
+eval $setvar
+
: Look for isascii
echo " "
$cat >isascii.c <<'EOCP'
set lockf d_lockf
eval $inlibc
+: check for long long
+echo " "
+$echo $n "Checking to see if your system supports long long..." $c >&4
+echo 'int main() { long long x = 7; return 0; }' > try.c
+set try
+if eval $compile; then
+ val="$define"
+ echo " Yes, it does." >&4
+else
+ val="$undef"
+ echo " No, it doesn't." >&4
+fi
+$rm try.*
+set d_longlong
+eval $setvar
+
+: check for length of long long
+case "${d_longlong}${longlongsize}" in
+$define)
+ echo " "
+ $echo $n "Checking to see how big your long longs are..." $c >&4
+ $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+ printf("%d\n", (int)sizeof(long long));
+ return(0);
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ longlongsize=`./try$exe_ext`
+ $echo " $longlongsize bytes." >&4
+ else
+ dflt='8'
+ echo " "
+ echo "(I can't seem to compile the test program. Guessing...)"
+ rp="What is the size of a long long (in bytes)?"
+ . ./myread
+ longlongsize="$ans"
+ fi
+ if $test "X$longsize" = "X$longlongsize"; then
+ echo "(That isn't any different from an ordinary long.)"
+ fi
+ ;;
+esac
+$rm -f try.* try
+
: see if lstat exists
set lstat d_lstat
eval $inlibc
-: see if madvise exists
-set madvise d_madvise
-eval $inlibc
-
: see if mblen exists
set mblen d_mblen
eval $inlibc
set mktime d_mktime
eval $inlibc
-: see if this is a sys/mman.h system
-set sys/mman.h i_sysmman
-eval $inhdr
-
-: see if mmap exists
-set mmap d_mmap
-eval $inlibc
-: see what shmat returns
-: default to something harmless
-mmaptype='void *'
-case "$i_sysmman$d_mmap" in
-"$define$define")
- $cat >mmap.c <<'END'
-#include <sys/mman.h>
-void *mmap();
-END
- if $cc $ccflags -c mmap.c >/dev/null 2>&1; then
- mmaptype='void *'
- else
- mmaptype='caddr_t'
- fi
- echo "and it returns ($mmaptype)." >&4
- ;;
-esac
-
-
-
-: see if mprotect exists
-set mprotect d_mprotect
-eval $inlibc
-
: see if msgctl exists
set msgctl d_msgctl
eval $inlibc
set d_msg
eval $setvar
-: see if msync exists
-set msync d_msync
-eval $inlibc
-
-: see if munmap exists
-set munmap d_munmap
-eval $inlibc
-
: see if nice exists
set nice d_nice
eval $inlibc
;;
esac
+
+echo " "
+echo "Checking which 64-bit integer type we could use..." >&4
+
+case "$intsize" in
+8) val=int
+ set quadtype
+ eval $setvar
+ val='"unsigned int"'
+ set uquadtype
+ eval $setvar
+ quadkind=1
+ ;;
+*) case "$longsize" in
+ 8) val=long
+ set quadtype
+ eval $setvar
+ val='"unsigned long"'
+ set uquadtype
+ eval $setvar
+ quadkind=2
+ ;;
+ *) case "$uselonglong:$d_longlong:$longlongsize" in
+ define:define:8)
+ val='"long long"'
+ set quadtype
+ eval $setvar
+ val='"unsigned long long"'
+ set uquadtype
+ eval $setvar
+ quadkind=3
+ ;;
+ *) case "$d_int64t" in
+ define)
+ val=int64_t
+ set quadtype
+ eval $setvar
+ val=uint64_t
+ set uquadtype
+ eval $setvar
+ quadkind=4
+ ;;
+ esac
+ ;;
+ esac
+ ;;
+ esac
+ ;;
+esac
+
+case "$quadtype" in
+'') case "$uselonglong:$d_longlong:$longlongsize" in
+ undef:define:8)
+ echo "(You would have 'long long', but you are not using it.)" >&4 ;;
+ *) echo "Alas, no 64-bit integer types in sight." >&4 ;;
+ esac
+ d_quad="$undef"
+ ;;
+*) if test X"$use64bits" = Xdefine -o X"$longsize" = X8; then
+ verb="will"
+ else
+ verb="could"
+ fi
+ echo "We $verb use '$quadtype' for 64-bit integers." >&4
+ d_quad="$define"
+ ;;
+esac
+
: see if readdir and friends exist
set readdir d_readdir
eval $inlibc
set readlink d_readlink
eval $inlibc
-: see if readv exists
-set readv d_readv
-eval $inlibc
-
: see if rename exists
set rename d_rename
eval $inlibc
struct sigaction act, oact;
act.sa_flags = 0;
oact.sa_handler = 0;
+ /* so that act and oact are used */
+ exit(act.sa_flags == 0 && oact.sa_handler == 0);
}
EOP
set try
eval $setvar
$rm -f try.c try
+: see if sqrtl exists
+set sqrtl d_sqrtl
+eval $inlibc
+
: see if sys/stat.h is available
set sys/stat.h i_sysstat
eval $inhdr
+
: see if stat knows about block sizes
echo " "
+echo "Checking to see if your struct stat has st_blocks field..." >&4
set d_statblks stat st_blocks $i_sysstat sys/stat.h
eval $hasfield
+
+: see if this is a sys/vfs.h system
+set sys/vfs.h i_sysvfs
+eval $inhdr
+
+
+: see if this is a sys/statfs.h system
+set sys/statfs.h i_sysstatfs
+eval $inhdr
+
+
+echo " "
+echo "Checking to see if your system supports struct statfs..." >&4
+set d_statfs_s statfs $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h $i_sysvfs sys/vfs.h $i_sysstatfs sys/statfs.h
+eval $hasstruct
+case "$d_statfs_s" in
+"$define") echo "Yes, it does." ;;
+*) echo "No, it doesn't." ;;
+esac
+
+
+
+: see if struct statfs knows about f_flags
+case "$d_statfs_s" in
+define)
+ echo " "
+ echo "Checking to see if your struct statfs has f_flags field..." >&4
+ set d_statfs_f_flags statfs f_flags $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h $i_sysvfs sys/vfs.h $i_sysstatfs sys/statfs.h
+ eval $hasfield
+ ;;
+*) val="$undef"
+ set d_statfs_f_flags
+ eval $setvar
+ ;;
+esac
+case "$d_statfs_f_flags" in
+"$define") echo "Yes, it does." ;;
+*) echo "No, it doesn't." ;;
+esac
+
: see if _ptr and _cnt from stdio act std
echo " "
if $contains '_IO_fpos_t' `./findhdr stdio.h` `./findhdr libio.h` >/dev/null 2>&1 ; then
set tcsetpgrp d_tcsetpgrp
eval $inlibc
-: see if sys/types.h has to be included
-set sys/types.h i_systypes
-eval $inhdr
-
: see if prototype for telldir is available
echo " "
set d_telldirproto telldir $i_systypes sys/types.h $i_dirent dirent.h
eval $hasproto
-: define an is-a-typedef? function
-typedef='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
-case "$inclist" in
-"") inclist="sys/types.h";;
-esac;
-eval "varval=\$$var";
-case "$varval" in
-"")
- $rm -f temp.c;
- for inc in $inclist; do
- echo "#include <$inc>" >>temp.c;
- done;
- echo "#ifdef $type" >> temp.c;
- echo "printf(\"We have $type\");" >> temp.c;
- echo "#endif" >> temp.c;
- $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
- if $contains $type temp.E >/dev/null 2>&1; then
- eval "$var=\$type";
- else
- eval "$var=\$def";
- fi;
- $rm -f temp.?;;
-*) eval "$var=\$varval";;
-esac'
-
-: define an is-a-typedef? function that prompts if the type is not available.
-typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
-case "$inclist" in
-"") inclist="sys/types.h";;
-esac;
-eval "varval=\$$var";
-case "$varval" in
-"")
- $rm -f temp.c;
- for inc in $inclist; do
- echo "#include <$inc>" >>temp.c;
- done;
- echo "#ifdef $type" >> temp.c;
- echo "printf(\"We have $type\");" >> temp.c;
- echo "#endif" >> temp.c;
- $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
- echo " " ;
- echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./";
- if $contains $type temp.E >/dev/null 2>&1; then
- echo "$type found." >&4;
- eval "$var=\$type";
- else
- echo "$type NOT found." >&4;
- dflt="$def";
- . ./myread ;
- eval "$var=\$ans";
- fi;
- $rm -f temp.?;;
-*) eval "$var=\$varval";;
-esac'
-
: see if this is a sys/times.h system
set sys/times.h i_systimes
eval $inhdr
set umask d_umask
eval $inlibc
+: see if ustat exists
+set ustat d_ustat
+eval $inlibc
+
: backward compatibility for d_hvfork
if test X$d_hvfork != X; then
d_vfork="$d_hvfork"
set wctomb d_wctomb
eval $inlibc
-: see if writev exists
-set writev d_writev
-eval $inlibc
-
: preserve RCS keywords in files with variable substitution, grrr
Date='$Date'
Id='$Id'
case "$alignbytes" in
'') echo "Checking alignment constraints..." >&4
$cat >try.c <<'EOCP'
+#include <stdio.h>
struct foobar {
char foo;
double bar;
} try_algn;
int main()
{
- printf("%d\n", (char *)&try_algn.bar - (char *)&try_algn.foo);
+ printf("%d\n", (int)((char *)&try_algn.bar - (char *)&try_algn.foo));
+ return(0);
}
EOCP
set try
#include <sys/types.h>
#include <db.h>
-#ifndef DB_VERSION_MAJOR
-size_t prefix_cb (key1, key2)
-const DBT *key1;
-const DBT *key2;
-{
-}
-BTREEINFO info;
+#ifndef DB_VERSION_MAJOR
+size_t prefix_cb (key1, key2)
+const DBT *key1;
+const DBT *key2;
+{
+}
+BTREEINFO info;
+int main()
+{
+ info.prefix = prefix_cb;
+}
+#endif
+EOCP
+ if $cc $ccflags -c try.c >try.out 2>&1 ; then
+ if $contains warning try.out >>/dev/null 2>&1 ; then
+ db_prefixtype='int'
+ else
+ db_prefixtype='size_t'
+ fi
+ else
+ db_prefixtype='size_t'
+ : XXX Maybe we should just give up here.
+ $cat try.out >&4
+ echo "Help: I can't seem to compile the db test program." >&4
+ echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4
+ fi
+ $rm -f try.*
+ echo "Your version of Berkeley DB uses $db_prefixtype for prefix."
+ ;;
+*) db_prefixtype='size_t'
+ ;;
+esac
+
+: check for void type
+echo " "
+echo "Checking to see how well your C compiler groks the void type..." >&4
+case "$voidflags" in
+'')
+ $cat >try.c <<'EOCP'
+#if TRY & 1
+void sub() {
+#else
+sub() {
+#endif
+ extern void moo(); /* function returning void */
+ void (*goo)(); /* ptr to func returning void */
+#if TRY & 8
+ void *hue; /* generic ptr */
+#endif
+#if TRY & 2
+ void (*foo[10])();
+#endif
+
+#if TRY & 4
+ if(goo == moo) {
+ exit(0);
+ }
+#endif
+ exit(0);
+}
+int main() { sub(); }
+EOCP
+ if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
+ voidflags=$defvoidused
+ echo "Good. It appears to support void to the level $package wants.">&4
+ if $contains warning .out >/dev/null 2>&1; then
+ echo "However, you might get some warnings that look like this:"
+ $cat .out
+ fi
+ else
+echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4
+ if $cc $ccflags -c -DTRY=1 try.c >/dev/null 2>&1; then
+ echo "It supports 1..."
+ if $cc $ccflags -c -DTRY=3 try.c >/dev/null 2>&1; then
+ echo "It also supports 2..."
+ if $cc $ccflags -c -DTRY=7 try.c >/dev/null 2>&1; then
+ voidflags=7
+ echo "And it supports 4 but not 8 definitely."
+ else
+ echo "It doesn't support 4..."
+ if $cc $ccflags -c -DTRY=11 try.c >/dev/null 2>&1; then
+ voidflags=11
+ echo "But it supports 8."
+ else
+ voidflags=3
+ echo "Neither does it support 8."
+ fi
+ fi
+ else
+ echo "It does not support 2..."
+ if $cc $ccflags -c -DTRY=13 try.c >/dev/null 2>&1; then
+ voidflags=13
+ echo "But it supports 4 and 8."
+ else
+ if $cc $ccflags -c -DTRY=5 try.c >/dev/null 2>&1; then
+ voidflags=5
+ echo "And it supports 4 but has not heard about 8."
+ else
+ echo "However it supports 8 but not 4."
+ fi
+ fi
+ fi
+ else
+ echo "There is no support at all for void."
+ voidflags=0
+ fi
+ fi
+esac
+case "$voidflags" in
+"$defvoidused") ;;
+*) $cat >&4 <<'EOM'
+ Support flag bits are:
+ 1: basic void declarations.
+ 2: arrays of pointers to functions returning void.
+ 4: operations between pointers to and addresses of void functions.
+ 8: generic void pointers.
+EOM
+ dflt="$voidflags";
+ rp="Your void support flags add up to what?"
+ . ./myread
+ voidflags="$ans"
+ ;;
+esac
+$rm -f try.* .out
+
+
+: How can we generate normalized random numbers ?
+echo " "
+echo "Looking for a random number function..." >&4
+case "$randfunc" in
+'')
+ if set drand48 val -f; eval $csym; $val; then
+ dflt="drand48"
+ echo "Good, found drand48()." >&4
+ elif set random val -f; eval $csym; $val; then
+ dflt="random"
+ echo "OK, found random()." >&4
+ else
+ dflt="rand"
+ echo "Yick, looks like I have to use rand()." >&4
+ fi
+ echo " "
+ ;;
+*)
+ dflt="$randfunc"
+ ;;
+esac
+cont=true
+
+case "$ccflags" in
+*-Dmy_rand=*|*-Dmy_srand=*)
+ echo "Removing obsolete -Dmy_rand, -Dmy_srand, and -Drandbits from ccflags." >&4
+ ccflags="`echo $ccflags | sed -e 's/-Dmy_rand=random/ /'`"
+ ccflags="`echo $ccflags | sed -e 's/-Dmy_srand=srandom/ /'`"
+ ccflags="`echo $ccflags | sed -e 's/-Drandbits=[0-9][0-9]*/ /'`"
+ ;;
+esac
+
+while $test "$cont"; do
+ rp="Use which function to generate random numbers?"
+ . ./myread
+ if $test "$ans" = "$dflt"; then
+ : null
+ else
+ randbits=''
+ fi
+ randfunc="$ans"
+ if set $ans val -f; eval $csym; $val; then
+ cont=''
+ else
+ dflt=y
+ rp="I cannot find function $ans. Use that name anyway?"
+ . ./myread
+ dflt=rand
+ case "$ans" in
+ [yY]*) cont='';;
+ esac
+ fi
+ case "$cont" in
+ '')
+ case "$randfunc" in
+ drand48)
+ drand01="drand48()"
+ seedfunc="srand48"
+ randbits=48
+ randseedtype=long
+ ;;
+ rand|random)
+ case "$randbits" in
+ '')
+echo "Checking to see how many bits your $randfunc() function produces..." >&4
+ $cat >try.c <<EOCP
+#$i_unistd I_UNISTD
+#$i_stdlib I_STDLIB
+#include <stdio.h>
+#ifdef I_UNISTD
+# include <unistd.h>
+#endif
+#ifdef I_STDLIB
+# include <stdlib.h>
+#endif
+int main()
+{
+ register int i;
+ register unsigned long tmp;
+ register unsigned long max = 0L;
+
+ for (i = 1000; i; i--) {
+ tmp = (unsigned long) $randfunc();
+ if (tmp > max) max = tmp;
+ }
+ for (i = 0; max; i++)
+ max /= 2;
+ printf("%d\n",i);
+}
+EOCP
+ set try
+ if eval $compile_ok; then
+ dflt=`try`
+ else
+ dflt='?'
+ echo "(I can't seem to compile the test program...)"
+ fi
+ ;;
+ *)
+ dflt="$randbits"
+ ;;
+ esac
+ rp="How many bits does your $randfunc() function produce?"
+ . ./myread
+ randbits="$ans"
+ $rm -f try.c try
+ drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
+ seedfunc="s$randfunc"
+ randseedtype=unsigned
+ ;;
+ *)
+ dflt="31"
+ rp="How many bits does your $randfunc() function produce?"
+ . ./myread
+ randbits="$ans"
+ seedfunc="s$randfunc"
+ drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
+ if set $seedfunc val -f; eval $csym; $val; then
+ echo "(Using $seedfunc() to seed random generator)"
+ else
+ echo "(Warning: no $seedfunc() to seed random generator)"
+ seedfunc=rand
+ fi
+ randseedtype=unsigned
+ ;;
+ esac
+ ;;
+ esac
+done
+
+echo " "
+echo "Determining whether or not we are on an EBCDIC system..." >&4
+$cat >tebcdic.c <<'EOM'
int main()
{
- info.prefix = prefix_cb;
+ if ('M'==0xd4) return 0;
+ return 1;
}
-#endif
-EOCP
- if $cc $ccflags -c try.c >try.out 2>&1 ; then
- if $contains warning try.out >>/dev/null 2>&1 ; then
- db_prefixtype='int'
- else
- db_prefixtype='size_t'
- fi
+EOM
+
+val=$undef
+set tebcdic
+if eval $compile_ok; then
+ if ./tebcdic; then
+ echo "You have EBCDIC." >&4
+ val="$define"
else
- db_prefixtype='size_t'
- : XXX Maybe we should just give up here.
- $cat try.out >&4
- echo "Help: I can't seem to compile the db test program." >&4
- echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4
+ echo "Nope, no EBCDIC, probably ASCII or some ISO Latin." >&4
fi
- $rm -f try.*
- echo "Your version of Berkeley DB uses $db_prefixtype for prefix."
- ;;
-*) db_prefixtype='size_t'
- ;;
-esac
+else
+ echo "I'm unable to compile the test program." >&4
+ echo "I'll assume ASCII or some ISO Latin." >&4
+fi
+$rm -f tebcdic.c tebcdic
+set ebcdic
+eval $setvar
-: check for void type
echo " "
-echo "Checking to see how well your C compiler groks the void type..." >&4
-case "$voidflags" in
-'')
- $cat >try.c <<'EOCP'
-#if TRY & 1
-void sub() {
-#else
-sub() {
+$cat >&4 <<EOM
+Checking how to flush all pending stdio output...
+EOM
+# I only know how to find the first 32 possibly open files on SunOS.
+# See also hints/sunos_4_1.sh and util.c --AD
+case "$osname" in
+sunos) $echo '#define PERL_FFLUSH_ALL_FOPEN_MAX 32' > try.c ;;
+esac
+$cat >>try.c <<EOCP
+#include <stdio.h>
+#$i_unistd I_UNISTD
+#ifdef I_UNISTD
+# include <unistd.h>
#endif
- extern void moo(); /* function returning void */
- void (*goo)(); /* ptr to func returning void */
-#if TRY & 8
- void *hue; /* generic ptr */
+#$d_sysconf HAS_SYSCONF
+#$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY
+#ifdef HAS_STDIO_STREAM_ARRAY
+# define STDIO_STREAM_ARRAY $stdio_stream_array
#endif
-#if TRY & 2
- void (*foo[10])();
+int main() {
+ FILE* p = fopen("try.out", "w");
+#ifdef TRY_FPUTC
+ fputc('x', p);
+#else
+# ifdef TRY_FPRINTF
+ fprintf(p, "x");
+# endif
#endif
-
-#if TRY & 4
- if(goo == moo) {
- exit(0);
- }
+#ifdef TRY_FFLUSH_NULL
+ fflush(NULL);
#endif
- exit(0);
+#ifdef TRY_FFLUSH_ALL
+ {
+ long open_max = -1;
+# ifdef PERL_FFLUSH_ALL_FOPEN_MAX
+ open_max = PERL_FFLUSH_ALL_FOPEN_MAX;
+# else
+# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
+ open_max = sysconf(_SC_OPEN_MAX);
+# else
+# ifdef FOPEN_MAX
+ open_max = FOPEN_MAX;
+# else
+# ifdef OPEN_MAX
+ open_max = OPEN_MAX;
+# else
+# ifdef _NFILE
+ open_max = _NFILE;
+# endif
+# endif
+# endif
+# endif
+# endif
+# ifdef HAS_STDIO_STREAM_ARRAY
+ if (open_max > 0) {
+ long i;
+ for (i = 0; i < open_max; i++)
+ if (STDIO_STREAM_ARRAY[i]._file >= 0 &&
+ STDIO_STREAM_ARRAY[i]._file < open_max &&
+ STDIO_STREAM_ARRAY[i]._flag)
+ fflush(&STDIO_STREAM_ARRAY[i]);
+ }
+ }
+# endif
+#endif
+ _exit(42);
}
-int main() { sub(); }
EOCP
- if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
- voidflags=$defvoidused
- echo "Good. It appears to support void to the level $package wants.">&4
- if $contains warning .out >/dev/null 2>&1; then
- echo "However, you might get some warnings that look like this:"
- $cat .out
+: first we have to find out how _not_ to flush
+if $test "X$fflushNULL" = X -o "X$fflushall" = X; then
+ output=''
+ set try -DTRY_FPUTC
+ if eval $compile; then
+ $rm -f try.out
+ ./try$exe_ext 2>/dev/null
+ if $test ! -s try.out -a "X$?" = X42; then
+ output=-DTRY_FPUTC
+ fi
+ fi
+ case "$output" in
+ '')
+ set try -DTRY_FPRINTF
+ $rm -f try.out
+ if eval $compile; then
+ $rm -f try.out
+ ./try$exe_ext 2>/dev/null
+ if $test ! -s try.out -a "X$?" = X42; then
+ output=-DTRY_FPRINTF
+ fi
+ fi
+ ;;
+ esac
+fi
+: check for fflush NULL behaviour
+case "$fflushNULL" in
+'') set try -DTRY_FFLUSH_NULL $output
+ if eval $compile; then
+ $rm -f try.out
+ ./try$exe_ext 2>/dev/null
+ code="$?"
+ if $test -s try.out -a "X$code" = X42; then
+ fflushNULL="`$cat try.out`"
+ else
+ if $test "X$code" != X42; then
+ $cat >&4 <<EOM
+(If this test failed, don't worry, we'll try another method shortly.)
+EOM
+ fi
fi
- else
-echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4
- if $cc $ccflags -c -DTRY=1 try.c >/dev/null 2>&1; then
- echo "It supports 1..."
- if $cc $ccflags -c -DTRY=3 try.c >/dev/null 2>&1; then
- echo "It also supports 2..."
- if $cc $ccflags -c -DTRY=7 try.c >/dev/null 2>&1; then
- voidflags=7
- echo "And it supports 4 but not 8 definitely."
- else
- echo "It doesn't support 4..."
- if $cc $ccflags -c -DTRY=11 try.c >/dev/null 2>&1; then
- voidflags=11
- echo "But it supports 8."
- else
- voidflags=3
- echo "Neither does it support 8."
- fi
- fi
- else
- echo "It does not support 2..."
- if $cc $ccflags -c -DTRY=13 try.c >/dev/null 2>&1; then
- voidflags=13
- echo "But it supports 4 and 8."
- else
- if $cc $ccflags -c -DTRY=5 try.c >/dev/null 2>&1; then
- voidflags=5
- echo "And it supports 4 but has not heard about 8."
- else
- echo "However it supports 8 but not 4."
- fi
- fi
+ fi
+ $rm -f core try.core core.try.*
+ case "$fflushNULL" in
+ x) $cat >&4 <<EOM
+Your fflush(NULL) works okay.
+EOM
+ fflushNULL="$define"
+ ;;
+ '') $cat >&4 <<EOM
+Your fflush(NULL) isn't working (contrary to ANSI C).
+EOM
+ fflushNULL="$undef"
+ ;;
+ *) $cat >&4 <<EOM
+Cannot figure out whether your fflush(NULL) works or not.
+I'm assuming it doesn't (contrary to ANSI C).
+EOM
+ fflushNULL="$undef"
+ ;;
+ esac
+ ;;
+$define|true|[yY]*)
+ fflushNULL="$define"
+ ;;
+*)
+ fflushNULL="$undef"
+ ;;
+esac
+: check explicit looping only if NULL did not work
+case "$fflushNULL" in
+"$undef")
+ : check for fflush all behaviour
+ case "$fflushall" in
+ '') set try -DTRY_FFLUSH_ALL $output
+ if eval $compile; then
+ $cat >&4 <<EOM
+(Now testing the other method--but note that also this may fail.)
+EOM
+ $rm -f try.out
+ ./try$exe_ext 2>/dev/null
+ if $test -s try.out -a "X$?" = X42; then
+ fflushall="`$cat try.out`"
fi
- else
- echo "There is no support at all for void."
- voidflags=0
fi
- fi
+ $rm -f core try.core core.try.*
+ case "$fflushall" in
+ x) $cat >&4 <<EOM
+Whew. Flushing explicitly all the stdio streams works.
+EOM
+ fflushall="$define"
+ ;;
+ '') $cat >&4 <<EOM
+Sigh. Flushing explicitly all the stdio streams doesn't work.
+EOM
+ fflushall="$undef"
+ ;;
+ *) $cat >&4 <<EOM
+Cannot figure out whether flushing stdio streams explicitly works or not.
+I'm assuming it doesn't.
+EOM
+ fflushall="$undef"
+ ;;
+ esac
+ ;;
+ "$define"|true|[yY]*)
+ fflushall="$define"
+ ;;
+ *)
+ fflushall="$undef"
+ ;;
+ esac
+ ;;
+*) fflushall="$undef"
+ ;;
esac
-case "$voidflags" in
-"$defvoidused") ;;
-*) $cat >&4 <<'EOM'
- Support flag bits are:
- 1: basic void declarations.
- 2: arrays of pointers to functions returning void.
- 4: operations between pointers to and addresses of void functions.
- 8: generic void pointers.
+case "$fflushNULL$fflushall" in
+undefundef)
+ $cat <<EOM
+I cannot figure out how to flush pending stdio output.
EOM
- dflt="$voidflags";
- rp="Your void support flags add up to what?"
- . ./myread
- voidflags="$ans"
;;
esac
-$rm -f try.* .out
+$rm -f try.* try$exe_ext
+
+: Store the full pathname to the ar program for use in the C program
+: Respect a hint or command line value for full_ar.
+case "$full_ar" in
+'') full_ar=$ar ;;
+esac
+: Store the full pathname to the sed program for use in the C program
+full_sed=$sed
-: How can we generate normalized random numbers ?
+: see what type gids are declared as in the kernel
echo " "
-echo "Looking for a random number function..." >&4
-case "$randfunc" in
-'')
- if set drand48 val -f; eval $csym; $val; then
- dflt="drand48"
- echo "Good, found drand48()." >&4
- elif set random val -f; eval $csym; $val; then
- dflt="random"
- echo "OK, found random()." >&4
- else
- dflt="rand"
- echo "Yick, looks like I have to use rand()." >&4
- fi
- echo " "
- ;;
-*)
- dflt="$randfunc"
+echo "Looking for the type for group ids returned by getgid()."
+set gid_t gidtype xxx stdio.h sys/types.h
+eval $typedef
+case "$gidtype" in
+xxx)
+ xxx=`./findhdr sys/user.h`
+ set `grep 'groups\[NGROUPS\];' "$xxx" 2>/dev/null` unsigned short
+ case $1 in
+ unsigned) dflt="$1 $2" ;;
+ *) dflt="$1" ;;
+ esac
;;
+*) dflt="$gidtype";;
esac
-cont=true
-
-case "$ccflags" in
-*-Dmy_rand=*|*-Dmy_srand=*)
- echo "Removing obsolete -Dmy_rand, -Dmy_srand, and -Drandbits from ccflags." >&4
- ccflags="`echo $ccflags | sed -e 's/-Dmy_rand=random/ /'`"
- ccflags="`echo $ccflags | sed -e 's/-Dmy_srand=srandom/ /'`"
- ccflags="`echo $ccflags | sed -e 's/-Drandbits=[0-9][0-9]*/ /'`"
+case "$gidtype" in
+gid_t) echo "gid_t found." ;;
+*) rp="What is the type for group ids returned by getgid()?"
+ . ./myread
+ gidtype="$ans"
;;
esac
-while $test "$cont"; do
- rp="Use which function to generate random numbers?"
- . ./myread
- if $test "$ans" = "$dflt"; then
- : null
- else
- randbits=''
- fi
- randfunc="$ans"
- if set $ans val -f; eval $csym; $val; then
- cont=''
- else
- dflt=y
- rp="I cannot find function $ans. Use that name anyway?"
- . ./myread
- dflt=rand
- case "$ans" in
- [yY]*) cont='';;
- esac
- fi
- case "$cont" in
- '')
- case "$randfunc" in
- drand48)
- drand01="drand48()"
- seedfunc="srand48"
- randbits=48
- randseedtype=long
- ;;
- rand|random)
- case "$randbits" in
- '')
-echo "Checking to see how many bits your $randfunc() function produces..." >&4
- $cat >try.c <<EOCP
-#$i_unistd I_UNISTD
-#$i_stdlib I_STDLIB
+echo " "
+case "$gidtype" in
+*_t) zzz="$gidtype" ;;
+*) zzz="gid" ;;
+esac
+echo "Checking the size of $zzz..." >&4
+cat > try.c <<EOCP
+#include <sys/types.h>
#include <stdio.h>
-#ifdef I_UNISTD
-# include <unistd.h>
-#endif
-#ifdef I_STDLIB
-# include <stdlib.h>
-#endif
-int main()
-{
- register int i;
- register unsigned long tmp;
- register unsigned long max = 0L;
+int main() {
+ printf("%d\n", (int)sizeof($gidtype));
+ exit(0);
+}
+EOCP
+set try
+if eval $compile_ok; then
+ yyy=`./try`
+ case "$yyy" in
+ '') gidsize=4
+ echo "(I can't execute the test program--guessing $gidsize.)" >&4
+ ;;
+ *) gidsize=$yyy
+ echo "Your $zzz size is $gidsize bytes."
+ ;;
+ esac
+else
+ gidsize=4
+ echo "(I can't compile the test program--guessing $gidsize.)" >&4
+fi
- for (i = 1000; i; i--) {
- tmp = (unsigned long) $randfunc();
- if (tmp > max) max = tmp;
- }
- for (i = 0; max; i++)
- max /= 2;
- printf("%d\n",i);
+
+echo " "
+case "$gidtype" in
+*_t) zzz="$gidtype" ;;
+*) zzz="gid" ;;
+esac
+echo "Checking the sign of $zzz..." >&4
+cat > try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ $gidtype foo = -1;
+ if (foo < 0)
+ printf("-1\n");
+ else
+ printf("1\n");
}
EOCP
- set try
- if eval $compile_ok; then
- dflt=`try`
- else
- dflt='?'
- echo "(I can't seem to compile the test program...)"
- fi
- ;;
- *)
- dflt="$randbits"
- ;;
- esac
- rp="How many bits does your $randfunc() function produce?"
- . ./myread
- randbits="$ans"
- $rm -f try.c try
- drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
- seedfunc="s$randfunc"
- randseedtype=unsigned
- ;;
- *)
- dflt="31"
- rp="How many bits does your $randfunc() function produce?"
- . ./myread
- randbits="$ans"
- seedfunc="s$randfunc"
- drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))"
- if set $seedfunc val -f; eval $csym; $val; then
- echo "(Using $seedfunc() to seed random generator)"
- else
- echo "(Warning: no $seedfunc() to seed random generator)"
- seedfunc=rand
- fi
- randseedtype=unsigned
- ;;
+set try
+if eval $compile; then
+ yyy=`./try`
+ case "$yyy" in
+ '') gidsign=1
+ echo "(I can't execute the test program--guessing unsigned.)" >&4
+ ;;
+ *) gidsign=$yyy
+ case "$gidsign" in
+ 1) echo "Your $zzz is unsigned." ;;
+ -1) echo "Your $zzz is signed." ;;
esac
;;
esac
-done
+else
+ gidsign=1
+ echo "(I can't compile the test program--guessing unsigned.)" >&4
+fi
+
+: check for length of character
echo " "
-echo "Determining whether or not we are on an EBCDIC system..." >&4
-$cat >tebcdic.c <<'EOM'
+case "$charsize" in
+'')
+ echo "Checking to see how big your characters are (hey, you never know)..." >&4
+ $cat >try.c <<'EOCP'
+#include <stdio.h>
int main()
{
- if ('M'==0xd4) return 0;
- return 1;
+ printf("%d\n", (int)sizeof(char));
+ exit(0);
}
-EOM
-
-val=$undef
-set tebcdic
-if eval $compile_ok; then
- if ./tebcdic; then
- echo "You have EBCDIC." >&4
- val="$define"
+EOCP
+ set try
+ if eval $compile_ok; then
+ dflt=`./try`
else
- echo "Nope, no EBCDIC, probably ASCII or some ISO Latin." >&4
+ dflt='1'
+ echo "(I can't seem to compile the test program. Guessing...)"
fi
-else
- echo "I'm unable to compile the test program." >&4
- echo "I'll assume ASCII or some ISO Latin." >&4
-fi
-$rm -f tebcdic.c tebcdic
-set ebcdic
-eval $setvar
+ ;;
+*)
+ dflt="$charsize"
+ ;;
+esac
+rp="What is the size of a character (in bytes)?"
+. ./myread
+charsize="$ans"
+$rm -f try.c try
+
echo " "
-$cat >&4 <<EOM
-Checking how to flush all pending stdio output...
-EOM
-# I only know how to find the first 32 possibly open files on SunOS.
-# See also hints/sunos_4_1.sh and util.c --AD
-case "$osname" in
-sunos) $echo '#define PERL_FFLUSH_ALL_FOPEN_MAX 32' > try.c ;;
+$echo "Choosing the C types to be used for Perl's internal types..." >&4
+
+case "$use64bits:$d_quad:$quadtype" in
+define:define:?*)
+ ivtype="$quadtype"
+ uvtype="$uquadtype"
+ ivsize=8
+ uvsize=8
+ ;;
+*) ivtype="long"
+ uvtype="unsigned long"
+ ivsize=$longsize
+ uvsize=$longsize
+ ;;
esac
-$cat >>try.c <<EOCP
-#include <stdio.h>
-#$i_unistd I_UNISTD
-#ifdef I_UNISTD
-# include <unistd.h>
-#endif
-#$d_sysconf HAS_SYSCONF
-#$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY
-#ifdef HAS_STDIO_STREAM_ARRAY
-# define STDIO_STREAM_ARRAY $stdio_stream_array
+
+case "$uselongdouble:$d_longdbl" in
+define:define)
+ nvtype="long double"
+ nvsize=$longdblsize
+ ;;
+*) nvtype=double
+ nvsize=$doublesize
+ ;;
+esac
+
+echo "(IV will be "$ivtype", $ivsize bytes)"
+echo "(UV will be "$uvtype", $uvsize bytes)"
+echo "(NV will be "$nvtype", $nvsize bytes)"
+
+$cat >try.c <<EOCP
+#$i_inttypes I_INTTYPES
+#ifdef I_INTTYPES
+#include <inttypes.h>
#endif
+#include <stdio.h>
int main() {
- FILE* p = fopen("try.out", "w");
-#ifdef TRY_FPUTC
- fputc('x', p);
-#else
-# ifdef TRY_FPRINTF
- fprintf(p, "x");
-# endif
+#ifdef INT8
+ int8_t i = INT8_MAX;
+ uint8_t u = UINT8_MAX;
+ printf("int8_t\n");
#endif
-#ifdef TRY_FFLUSH_NULL
- fflush(NULL);
+#ifdef INT16
+ int16_t i = INT16_MAX;
+ uint16_t i = UINT16_MAX;
+ printf("int16_t\n");
#endif
-#ifdef TRY_FFLUSH_ALL
- {
- long open_max = -1;
-# ifdef PERL_FFLUSH_ALL_FOPEN_MAX
- open_max = PERL_FFLUSH_ALL_FOPEN_MAX;
-# else
-# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
- open_max = sysconf(_SC_OPEN_MAX);
-# else
-# ifdef FOPEN_MAX
- open_max = FOPEN_MAX;
-# else
-# ifdef OPEN_MAX
- open_max = OPEN_MAX;
-# else
-# ifdef _NFILE
- open_max = _NFILE;
-# endif
-# endif
-# endif
-# endif
-# endif
-# ifdef HAS_STDIO_STREAM_ARRAY
- if (open_max > 0) {
- long i;
- for (i = 0; i < open_max; i++)
- if (STDIO_STREAM_ARRAY[i]._file >= 0 &&
- STDIO_STREAM_ARRAY[i]._file < open_max &&
- STDIO_STREAM_ARRAY[i]._flag)
- fflush(&STDIO_STREAM_ARRAY[i]);
- }
- }
-# endif
+#ifdef INT32
+ int32_t i = INT32_MAX;
+ uint32_t u = UINT32_MAX;
+ printf("int32_t\n");
#endif
- _exit(42);
}
EOCP
-: first we have to find out how _not_ to flush
-if $test "X$fflushNULL" = X -o "X$fflushall" = X; then
- output=''
- set try -DTRY_FPUTC
- if eval $compile; then
- $rm -f try.out
- ./try$exe_ext 2>/dev/null
- if $test ! -s try.out -a "X$?" = X42; then
- output=-DTRY_FPUTC
- fi
- fi
- case "$output" in
- '')
- set try -DTRY_FPRINTF
- $rm -f try.out
- if eval $compile; then
- $rm -f try.out
- ./try$exe_ext 2>/dev/null
- if $test ! -s try.out -a "X$?" = X42; then
- output=-DTRY_FPRINTF
- fi
- fi
+
+case "$i8type" in
+'') case "$charsize" in
+ 1) i8type=char
+ u8type="unsigned char"
+ i8size=$charsize
+ u8size=$charsize
+ ;;
+ esac
;;
- esac
-fi
-: check for fflush NULL behaviour
-case "$fflushNULL" in
-'') set try -DTRY_FFLUSH_NULL $output
+esac
+case "$i8type" in
+'') set try -DINT8
if eval $compile; then
- $rm -f try.out
- ./try$exe_ext 2>/dev/null
- code="$?"
- if $test -s try.out -a "X$code" = X42; then
- fflushNULL="`$cat try.out`"
- else
- if $test "X$code" != X42; then
- $cat >&4 <<EOM
-(If this test failed, don't worry, we'll try another method shortly.)
-EOM
- fi
- fi
+ case "`./try$exe_ext`" in
+ int8_t) i8type=int8_t
+ u8type=uint8_t
+ i8size=1
+ u8size=1
+ ;;
+ esac
fi
- $rm -f core try.core core.try.*
- case "$fflushNULL" in
- x) $cat >&4 <<EOM
-Your fflush(NULL) works okay.
-EOM
- fflushNULL="$define"
+ ;;
+esac
+case "$i8type" in
+'') if $test $charsize -ge 1; then
+ i8type=char
+ u8type="unsigned char"
+ i8size=$charsize
+ u8size=$charsize
+ fi
+ ;;
+esac
+
+case "$i16type" in
+'') case "$shortsize" in
+ 2) i16type=short
+ u16type="unsigned short"
+ i16size=$shortsize
+ u16size=$shortsize
;;
- '') $cat >&4 <<EOM
-Your fflush(NULL) isn't working (contrary to ANSI C).
-EOM
- fflushNULL="$undef"
+ esac
+ ;;
+esac
+case "$i16type" in
+'') set try -DINT16
+ if eval $compile; then
+ case "`./try$exe_ext`" in
+ int16_t)
+ i16type=int16_t
+ u16type=uint16_t
+ i16size=2
+ u16size=2
+ ;;
+ esac
+ fi
+ ;;
+esac
+case "$i16type" in
+'') if $test $shortsize -ge 2; then
+ i16type=short
+ u16type="unsigned short"
+ i16size=$shortsize
+ u16size=$shortsize
+ fi
+ ;;
+esac
+
+case "$i32type" in
+'') case "$longsize" in
+ 4) i32type=long
+ u32type="unsigned long"
+ i32size=$longsize
+ u32size=$longsize
;;
- *) $cat >&4 <<EOM
-Cannot figure out whether your fflush(NULL) works or not.
-I'm assuming it doesn't (contrary to ANSI C).
-EOM
- fflushNULL="$undef"
+ *) case "$intsize" in
+ 4) i32type=int
+ u32type="unsigned int"
+ i32size=$intsize
+ u32size=$intsize
+ ;;
+ esac
;;
esac
;;
-$define|true|[yY]*)
- fflushNULL="$define"
+esac
+case "$i32type" in
+'') set try -DINT32
+ if eval $compile; then
+ case "`./try$exe_ext`" in
+ int32_t)
+ i32type=int32_t
+ u32type=uint32_t
+ i32size=4
+ u32size=4
+ ;;
+ esac
+ fi
;;
-*)
- fflushNULL="$undef"
+esac
+case "$i32type" in
+'') if $test $intsize -ge 4; then
+ i32type=int
+ u32type="unsigned int"
+ i32size=$intsize
+ u32size=$intsize
+ fi
;;
esac
-: check explicit looping only if NULL did not work
-case "$fflushNULL" in
-"$undef")
- : check for fflush all behaviour
- case "$fflushall" in
- '') set try -DTRY_FFLUSH_ALL $output
- if eval $compile; then
- $cat >&4 <<EOM
-(Now testing the other method--but note that also this may fail.)
-EOM
- $rm -f try.out
- ./try$exe_ext 2>/dev/null
- if $test -s try.out -a "X$?" = X42; then
- fflushall="`$cat try.out`"
- fi
- fi
- $rm -f core try.core core.try.*
- case "$fflushall" in
- x) $cat >&4 <<EOM
-Whew. Flushing explicitly all the stdio streams works.
-EOM
- fflushall="$define"
+
+case "$i64type" in
+'') case "$d_quad:$quadtype" in
+ define:?*)
+ i64type="$quadtype"
+ u64type="$uquadtype"
+ i64size=8
+ u64size=8
+ ;;
+ esac
+ ;;
+esac
+
+$rm -f try.* try
+
+echo " "
+
+if $test X"$quadtype" != X; then
+
+echo "Checking how to print 64-bit integers..." >&4
+
+if $test X"$sPRId64" = X -a X"$quadtype" = Xint; then
+ $cat >try.c <<'EOCP'
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ int q = 12345678901;
+ printf("%ld\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"';
+ sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"';
+ echo "We will use %d."
+ ;;
+ esac
+ fi
+fi
+
+if $test X"$sPRId64" = X -a X"$quadtype" = Xlong; then
+ $cat >try.c <<'EOCP'
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ long q = 12345678901;
+ printf("%ld\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"';
+ sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"';
+ echo "We will use %ld."
+ ;;
+ esac
+ fi
+fi
+
+if $test X"$sPRId64" = X -a X"$i_inttypes.h" = X"$define" -a X"$quadtype" = Xint64_t; then
+ $cat >try.c <<'EOCP'
+#include <sys/types.h>
+#include <inttypes.h>
+#include <stdio.h>
+int main() {
+ int64_t q = 12345678901;
+ printf("%" PRId64 "\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64;
+ sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64;
+ echo "We will use the C9X style."
;;
- '') $cat >&4 <<EOM
-Sigh. Flushing explicitly all the stdio streams doesn't work.
-EOM
- fflushall="$undef"
+ esac
+ fi
+fi
+
+if $test X"$sPRId64" = X -a X"$quadtype" = X"long long"; then
+ $cat >try.c <<'EOCP'
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ long long q = 12345678901LL; /* AIX cc requires the LL prefix. */
+ printf("%lld\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"';
+ sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"';
+ echo "We will use the %lld style."
;;
- *) $cat >&4 <<EOM
-Cannot figure out whether flushing stdio streams explicitly works or not.
-I'm assuming it doesn't.
-EOM
- fflushall="$undef"
+ esac
+ fi
+fi
+
+if $test X"$sPRId64" = X -a X"$quadtype" != X; then
+ $cat >try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ $quadtype q = 12345678901;
+ printf("%Ld\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"';
+ sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"';
+ echo "We will use %Ld."
;;
esac
- ;;
- "$define"|true|[yY]*)
- fflushall="$define"
- ;;
- *)
- fflushall="$undef"
- ;;
- esac
- ;;
-*) fflushall="$undef"
+ fi
+fi
+
+if $test X"$sPRId64" = X -a X"$quadtype" != X; then
+ $cat >try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ $quadtype q = 12345678901;
+ printf("%qd\n", q);
+}
+EOCP
+ set try
+ if eval $compile; then
+ yyy=`./try$exe_ext`
+ case "$yyy" in
+ 12345678901)
+ sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"';
+ sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"';
+ echo "We will use %qd."
+ ;;
+ esac
+ fi
+fi
+
+if $test X"$sPRId64" = X; then
+ echo "Cannot figure out how to print 64-bit integers." >&4
+fi
+
+$rm -f try try.*
+
+fi
+
+case "$sPRId64" in
+'') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef";
+ d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef";
;;
-esac
-case "$fflushNULL$fflushall" in
-undefundef)
- $cat <<EOM
-I cannot figure out how to flush pending stdio output.
-EOM
+*) d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define";
+ d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define";
;;
esac
-$rm -f try.* try$exe_ext
-: see what type file positions are declared as in the library
-rp="What is the type for file position used by fsetpos()?"
-set fpos_t fpostype long stdio.h sys/types.h
-eval $typedef_ask
-: Store the full pathname to the ar program for use in the C program
-: Respect a hint or command line value for full_ar.
-case "$full_ar" in
-'') full_ar=$ar ;;
+echo " "
+$echo "Checking the format strings to be used for Perl's internal types..." >&4
+
+if $test X"$ivsize" = X8; then
+ ivdformat="$sPRId64"
+ uvuformat="$sPRIu64"
+ uvoformat="$sPRIo64"
+ uvxformat="$sPRIx64"
+else
+ if $test X"$ivsize" = X"$longsize"; then
+ ivdformat='"ld"'
+ uvuformat='"lu"'
+ uvoformat='"lo"'
+ uvxformat='"lx"'
+ else
+ if $test X"$ivsize" = X"$intsize"; then
+ ivdformat='"d"'
+ uvuformat='"u"'
+ uvoformat='"o"'
+ uvxformat='"x"'
+ else
+ : far out
+ if $test X"$ivsize" = X"$shortsize"; then
+ ivdformat='"hd"'
+ uvuformat='"hu"'
+ uvoformat='"ho"'
+ uvxformat='"hx"'
+ fi
+ fi
+ fi
+fi
+
+case "$ivdformat" in
+'') echo "$0: Fatal: failed to find format strings, cannot continue." >& 4
+ exit 1
+ ;;
esac
-: Store the full pathname to the sed program for use in the C program
-full_sed=$sed
-: see what type gids are declared as in the kernel
echo " "
-echo "Looking for the type for group ids returned by getgid()."
-set gid_t gidtype xxx stdio.h sys/types.h
-eval $typedef
-case "$gidtype" in
-xxx)
- xxx=`./findhdr sys/user.h`
- set `grep 'groups\[NGROUPS\];' "$xxx" 2>/dev/null` unsigned short
- case $1 in
- unsigned) dflt="$1 $2" ;;
- *) dflt="$1" ;;
- esac
+$echo "Checking the format string to be used for gids..." >&4
+
+case "$gidsign" in
+-1) if $test X"$gidsize" = X"$ivsize"; then
+ gidformat="$ivdformat"
+ else
+ if $test X"$gidsize" = X"$longsize"; then
+ gidformat='"ld"'
+ else
+ if $test X"$gidsize" = X"$intsize"; then
+ gidformat='"d"'
+ else
+ if $test X"$gidsize" = X"$shortsize"; then
+ gidformat='"hd"'
+ fi
+ fi
+ fi
+ fi
;;
-*) dflt="$gidtype";;
-esac
-case "$gidtype" in
-gid_t) echo "gid_t found." ;;
-*) rp="What is the type for group ids returned by getgid()?"
- . ./myread
- gidtype="$ans"
+*) if $test X"$gidsize" = X"$uvsize"; then
+ gidformat="$uvuformat"
+ else
+ if $test X"$gidsize" = X"$longsize"; then
+ gidformat='"lu"'
+ else
+ if $test X"$gidsize" = X"$intsize"; then
+ gidformat='"u"'
+ else
+ if $test X"$gidsize" = X"$shortsize"; then
+ gidformat='"hu"'
+ fi
+ fi
+ fi
+ fi
;;
esac
*) groupstype="$gidtype";;
esac
-: see what type lseek is declared as in the kernel
-rp="What is the type used for lseek's offset on this system?"
-set off_t lseektype long stdio.h sys/types.h
-eval $typedef_ask
-
-echo " "
-$echo $n "Checking to see how big your file offsets are...$c" >&4
-$cat >try.c <<EOCP
-#include <sys/types.h>
-#include <stdio.h>
-int main()
-{
- printf("%d\n", sizeof($lseektype));
-}
-EOCP
-set try
-if eval $compile_ok; then
- lseeksize=`./try`
- $echo " $lseeksize bytes." >&4
-else
- dflt='4'
- echo " "
- echo "(I can't seem to compile the test program. Guessing...)"
- rp="What is the size of your file offsets (in bytes)?"
- . ./myread
- lseeksize="$ans"
-fi
-$rm -f try.c try
-
echo " "
echo "Checking if your $make program sets \$(MAKE)..." >&4
case "$make_set_make" in
#include <stdio.h>
int main()
{
- printf("%d\n", sizeof(VOID_PTR));
- exit(0);
+ printf("%d\n", (int)sizeof(VOID_PTR));
+ exit(0);
}
EOCP
set try
: Remove SIGSTKSIZE used by Linux.
: Remove SIGSTKSZ used by Posix.
: Remove SIGTYP void lines used by OS2.
-xxx=`echo '#include <signal.h>' |
+if [ "X$fieldn" = X ]; then
+ xxx=`echo '#include <signal.h>' |
+ $cppstdin $cppminus $cppflags 2>/dev/null |
+ $grep '^[ ]*#.*include' |
+ $sed 's!"!!g' | $sort | $uniq`
+else
+ xxx=`echo '#include <signal.h>' |
$cppstdin $cppminus $cppflags 2>/dev/null |
$grep '^[ ]*#.*include' |
$awk "{print \\$$fieldn}" | $sed 's!"!!g' | $sort | $uniq`
+fi
: Check this list of files to be sure we have parsed the cpp output ok.
: This will also avoid potentially non-existent files, such
: as ../foo/bar.h
}
END {
printf "#endif /* JUST_NSIG */\n";
- printf "}\n";
+ printf "exit(0);\n}\n";
}
' >>signal.c
$cat >signal.awk <<'EOP'
*_t) zzz="$uidtype" ;;
*) zzz="uid" ;;
esac
+echo "Checking the size of $zzz..." >&4
+cat > try.c <<EOCP
+#include <sys/types.h>
+#include <stdio.h>
+int main() {
+ printf("%d\n", (int)sizeof($uidtype));
+ exit(0);
+}
+EOCP
+set try
+if eval $compile_ok; then
+ yyy=`./try`
+ case "$yyy" in
+ '') uidsize=4
+ echo "(I can't execute the test program--guessing $uidsize.)" >&4
+ ;;
+ *) uidsize=$yyy
+ echo "Your $zzz size is $uidsize bytes."
+ ;;
+ esac
+else
+ uidsize=4
+ echo "(I can't compile the test program--guessing $uidsize.)" >&4
+fi
+
+echo " "
+case "$uidtype" in
+*_t) zzz="$uidtype" ;;
+*) zzz="uid" ;;
+esac
echo "Checking the sign of $zzz..." >&4
cat > try.c <<EOCP
#include <sys/types.h>
fi
+
+echo " "
+$echo "Checking the format string to be used for uids..." >&4
+
+case "$uidsign" in
+-1) if $test X"$uidsize" = X"$ivsize"; then
+ uidformat="$ivdformat"
+ else
+ if $test X"$uidsize" = X"$longsize"; then
+ uidformat='"ld"'
+ else
+ if $test X"$uidsize" = X"$intsize"; then
+ uidformat='"d"'
+ else
+ if $test X"$uidsize" = X"$shortsize"; then
+ uidformat='"hd"'
+ fi
+ fi
+ fi
+ fi
+ ;;
+*) if $test X"$uidsize" = X"$uvsize"; then
+ uidformat="$uvuformat"
+ else
+ if $test X"$uidsize" = X"$longsize"; then
+ uidformat='"lu"'
+ else
+ if $test X"$uidsize" = X"$intsize"; then
+ uidformat='"u"'
+ else
+ if $test X"$uidsize" = X"$shortsize"; then
+ uidformat='"hu"'
+ fi
+ fi
+ fi
+ fi
+ ;;
+esac
+
: see if dbm.h is available
: see if dbmclose exists
set dbmclose d_dbmclose
set sys/statvfs.h i_sysstatvfs
eval $inhdr
+: see if this is a sys/uio.h system
+set sys/uio.h i_sysuio
+eval $inhdr
+
: see if this is a sys/un.h system
set sys/un.h i_sysun
eval $inhdr
set sys/wait.h i_syswait
eval $inhdr
+: see if this is a ustat.h system
+set ustat.h i_ustat
+eval $inhdr
+
: see if this is an utime system
set utime.h i_utime
eval $inhdr
cf_by='$cf_by'
cf_email='$cf_email'
cf_time='$cf_time'
+charsize='$charsize'
chgrp='$chgrp'
chmod='$chmod'
chown='$chown'
d_chroot='$d_chroot'
d_chsize='$d_chsize'
d_closedir='$d_closedir'
-d_cmsghdr_s='$d_cmsghdr_s'
d_const='$d_const'
d_crypt='$d_crypt'
d_csh='$d_csh'
d_fork='$d_fork'
d_fpathconf='$d_fpathconf'
d_fpos64_t='$d_fpos64_t'
+d_fs_data_s='$d_fs_data_s'
d_fseeko='$d_fseeko'
d_fsetpos='$d_fsetpos'
d_fstatfs='$d_fstatfs'
d_gethname='$d_gethname'
d_gethostprotos='$d_gethostprotos'
d_getlogin='$d_getlogin'
+d_getmnt='$d_getmnt'
d_getmntent='$d_getmntent'
d_getnbyaddr='$d_getnbyaddr'
d_getnbyname='$d_getnbyname'
d_index='$d_index'
d_inetaton='$d_inetaton'
d_int64t='$d_int64t'
-d_iovec_s='$d_iovec_s'
d_isascii='$d_isascii'
d_killpg='$d_killpg'
d_lchown='$d_lchown'
d_ldbl_dig='$d_ldbl_dig'
d_link='$d_link'
-d_llseek='$d_llseek'
d_locconv='$d_locconv'
d_lockf='$d_lockf'
d_longdbl='$d_longdbl'
d_longlong='$d_longlong'
d_lstat='$d_lstat'
-d_madvise='$d_madvise'
d_mblen='$d_mblen'
d_mbstowcs='$d_mbstowcs'
d_mbtowc='$d_mbtowc'
d_mkdir='$d_mkdir'
d_mkfifo='$d_mkfifo'
d_mktime='$d_mktime'
-d_mmap='$d_mmap'
-d_mprotect='$d_mprotect'
d_msg='$d_msg'
d_msg_ctrunc='$d_msg_ctrunc'
d_msg_dontroute='$d_msg_dontroute'
d_msg_proxy='$d_msg_proxy'
d_msgctl='$d_msgctl'
d_msgget='$d_msgget'
-d_msghdr_s='$d_msghdr_s'
d_msgrcv='$d_msgrcv'
d_msgsnd='$d_msgsnd'
-d_msync='$d_msync'
-d_munmap='$d_munmap'
d_mymalloc='$d_mymalloc'
d_nice='$d_nice'
d_off64_t='$d_off64_t'
d_pwgecos='$d_pwgecos'
d_pwpasswd='$d_pwpasswd'
d_pwquota='$d_pwquota'
+d_quad='$d_quad'
d_readdir='$d_readdir'
d_readlink='$d_readlink'
-d_readv='$d_readv'
-d_recvmsg='$d_recvmsg'
d_rename='$d_rename'
d_rewinddir='$d_rewinddir'
d_rmdir='$d_rmdir'
d_semctl_semun='$d_semctl_semun'
d_semget='$d_semget'
d_semop='$d_semop'
-d_sendmsg='$d_sendmsg'
d_setegid='$d_setegid'
d_seteuid='$d_seteuid'
d_setgrent='$d_setgrent'
d_sigsetjmp='$d_sigsetjmp'
d_socket='$d_socket'
d_sockpair='$d_sockpair'
+d_sqrtl='$d_sqrtl'
d_statblks='$d_statblks'
-d_statfs='$d_statfs'
-d_statfsflags='$d_statfsflags'
+d_statfs_f_flags='$d_statfs_f_flags'
+d_statfs_s='$d_statfs_s'
d_statvfs='$d_statvfs'
d_stdio_cnt_lval='$d_stdio_cnt_lval'
d_stdio_ptr_lval='$d_stdio_ptr_lval'
d_umask='$d_umask'
d_uname='$d_uname'
d_union_semun='$d_union_semun'
+d_ustat='$d_ustat'
+d_vendorbin='$d_vendorbin'
d_vendorlib='$d_vendorlib'
d_vfork='$d_vfork'
d_void_closedir='$d_void_closedir'
d_waitpid='$d_waitpid'
d_wcstombs='$d_wcstombs'
d_wctomb='$d_wctomb'
-d_writev='$d_writev'
d_xenix='$d_xenix'
date='$date'
db_hashtype='$db_hashtype'
find='$find'
firstmakefile='$firstmakefile'
flex='$flex'
+fpossize='$fpossize'
fpostype='$fpostype'
freetype='$freetype'
full_ar='$full_ar'
full_csh='$full_csh'
full_sed='$full_sed'
gccversion='$gccversion'
+gidformat='$gidformat'
+gidsign='$gidsign'
+gidsize='$gidsize'
gidtype='$gidtype'
glibpth='$glibpth'
grep='$grep'
hint='$hint'
hostcat='$hostcat'
huge='$huge'
+i16size='$i16size'
+i16type='$i16type'
+i32size='$i32size'
+i32type='$i32type'
+i64size='$i64size'
+i64type='$i64type'
+i8size='$i8size'
+i8type='$i8type'
i_arpainet='$i_arpainet'
i_bsdioctl='$i_bsdioctl'
i_db='$i_db'
i_sysfilio='$i_sysfilio'
i_sysin='$i_sysin'
i_sysioctl='$i_sysioctl'
-i_sysmman='$i_sysmman'
i_sysmount='$i_sysmount'
i_sysndir='$i_sysndir'
i_sysparam='$i_sysparam'
i_sysselct='$i_sysselct'
i_syssockio='$i_syssockio'
i_sysstat='$i_sysstat'
+i_sysstatfs='$i_sysstatfs'
i_sysstatvfs='$i_sysstatvfs'
i_systime='$i_systime'
i_systimek='$i_systimek'
i_systypes='$i_systypes'
i_sysuio='$i_sysuio'
i_sysun='$i_sysun'
+i_sysvfs='$i_sysvfs'
i_syswait='$i_syswait'
i_termio='$i_termio'
i_termios='$i_termios'
i_time='$i_time'
i_unistd='$i_unistd'
+i_ustat='$i_ustat'
i_utime='$i_utime'
i_values='$i_values'
i_varargs='$i_varargs'
installprivlib='$installprivlib'
installscript='$installscript'
installsitearch='$installsitearch'
+installsitebin='$installsitebin'
installsitelib='$installsitelib'
installstyle='$installstyle'
installusrbinperl='$installusrbinperl'
+installvendorbin='$installvendorbin'
installvendorlib='$installvendorlib'
intsize='$intsize'
+ivdformat='$ivdformat'
+ivsize='$ivsize'
+ivtype='$ivtype'
known_extensions='$known_extensions'
ksh='$ksh'
large='$large'
man3direxp='$man3direxp'
man3ext='$man3ext'
medium='$medium'
-mips='$mips'
mips_type='$mips_type'
mkdir='$mkdir'
-mmaptype='$mmaptype'
models='$models'
modetype='$modetype'
more='$more'
nm_so_opt='$nm_so_opt'
nonxs_ext='$nonxs_ext'
nroff='$nroff'
+nvsize='$nvsize'
+nvtype='$nvtype'
o_nonblock='$o_nonblock'
obj_ext='$obj_ext'
old_pthread_create_joinable='$old_pthread_create_joinable'
privlibexp='$privlibexp'
prototype='$prototype'
ptrsize='$ptrsize'
+quadkind='$quadkind'
+quadtype='$quadtype'
randbits='$randbits'
randfunc='$randfunc'
randseedtype='$randseedtype'
signal_t='$signal_t'
sitearch='$sitearch'
sitearchexp='$sitearchexp'
+sitebin='$sitebin'
+sitebinexp='$sitebinexp'
sitelib='$sitelib'
sitelibexp='$sitelibexp'
siteprefix='$siteprefix'
tr='$tr'
trnl='$trnl'
troff='$troff'
+u16size='$u16size'
+u16type='$u16type'
+u32size='$u32size'
+u32type='$u32type'
+u64size='$u64size'
+u64type='$u64type'
+u8size='$u8size'
+u8type='$u8type'
+uidformat='$uidformat'
uidsign='$uidsign'
+uidsize='$uidsize'
uidtype='$uidtype'
uname='$uname'
uniq='$uniq'
+uquadtype='$uquadtype'
use64bits='$use64bits'
usedl='$usedl'
uselargefiles='$uselargefiles'
uselongdouble='$uselongdouble'
+uselonglong='$uselonglong'
usemorebits='$usemorebits'
usemultiplicity='$usemultiplicity'
usemymalloc='$usemymalloc'
usevfork='$usevfork'
usrinc='$usrinc'
uuname='$uuname'
+uvoformat='$uvoformat'
+uvsize='$uvsize'
+uvtype='$uvtype'
+uvuformat='$uvuformat'
+uvxformat='$uvxformat'
+vendorbin='$vendorbin'
+vendorbinexp='$vendorbinexp'
vendorlib='$vendorlib'
vendorlibexp='$vendorlibexp'
vendorprefix='$vendorprefix'
=head1 SYNOPSIS
+First, make sure you are installing an up-to-date version of Perl. If
+you didn't get your Perl source from CPAN, check the latest version at
+<URL:http://www.perl.com/CPAN/src/>.
+
The basic steps to build and install perl5 on a Unix system are:
rm -f config.sh Policy.sh
make test
make install
-Full configuration instructions can be found in the INSTALL file.
-
For information on non-Unix systems, see the section on
L<"Porting information"> below.
embed.h Maps symbols to safer names
embed.pl Produces {embed,embedvar,objXSUB,proto}.h, global.sym
embedvar.h C namespace management
+epoc/autosplit.pl EPOC port
epoc/config.h EPOC port
+epoc/Config.pm EPOC port
+epoc/createpkg.pl EPOC port
epoc/epoc.c EPOC port
+epoc/epoc_stubs.c EPOC port
epoc/epocish.h EPOC port
epoc/perl.mmp EPOC port
epoc/perl.pkg EPOC port
ext/DynaLoader/DynaLoader_pm.PL Dynamic Loader perl module
ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer
ext/DynaLoader/README Dynamic Loader notes and intro
+ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module
ext/DynaLoader/dl_aix.xs AIX implementation
ext/DynaLoader/dl_beos.xs BeOS implementation
ext/DynaLoader/dl_cygwin.xs Cygwin implementation
lib/timelocal.pl Perl library supporting inverse of localtime, gmtime
lib/unicode/ArabLink.pl Unicode character database
lib/unicode/ArabLnkGrp.pl Unicode character database
+lib/unicode/ArabShap.txt Unicode character database
lib/unicode/Bidirectional.pl Unicode character database
lib/unicode/Block.pl Unicode character database
+lib/unicode/Blocks.txt Unicode character database
lib/unicode/Category.pl Unicode character database
lib/unicode/CombiningClass.pl Unicode character database
+lib/unicode/CompExcl.txt Unicode character database
lib/unicode/Decomposition.pl Unicode character database
-lib/unicode/Eq/Latin1 Unicode character database
-lib/unicode/Eq/Unicode Unicode character database
+lib/unicode/EAWidth.txt Unicode character database
+lib/unicode/Eq/Latin1.pl Unicode character database
+lib/unicode/Eq/Unicode.pl Unicode character database
lib/unicode/In/AlphabeticPresentationForms.pl Unicode character database
lib/unicode/In/Arabic.pl Unicode character database
lib/unicode/In/ArabicPresentationForms-A.pl Unicode character database
lib/unicode/In/Bengali.pl Unicode character database
lib/unicode/In/BlockElements.pl Unicode character database
lib/unicode/In/Bopomofo.pl Unicode character database
+lib/unicode/In/BopomofoExtended.pl Unicode character database
lib/unicode/In/BoxDrawing.pl Unicode character database
+lib/unicode/In/BraillePatterns.pl Unicode character database
lib/unicode/In/CJKCompatibility.pl Unicode character database
lib/unicode/In/CJKCompatibilityForms.pl Unicode character database
lib/unicode/In/CJKCompatibilityIdeographs.pl Unicode character database
+lib/unicode/In/CJKRadicalsSupplement.pl Unicode character database
lib/unicode/In/CJKSymbolsandPunctuation.pl Unicode character database
lib/unicode/In/CJKUnifiedIdeographs.pl Unicode character database
+lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl Unicode character database
+lib/unicode/In/Cherokee.pl Unicode character database
lib/unicode/In/CombiningDiacriticalMarks.pl Unicode character database
lib/unicode/In/CombiningHalfMarks.pl Unicode character database
lib/unicode/In/CombiningMarksforSymbols.pl Unicode character database
lib/unicode/In/HighSurrogates.pl Unicode character database
lib/unicode/In/Hiragana.pl Unicode character database
lib/unicode/In/IPAExtensions.pl Unicode character database
+lib/unicode/In/IdeographicDescriptionCharacters.pl Unicode character database
lib/unicode/In/Kanbun.pl Unicode character database
+lib/unicode/In/KangxiRadicals.pl Unicode character database
lib/unicode/In/Kannada.pl Unicode character database
lib/unicode/In/Katakana.pl Unicode character database
+lib/unicode/In/Khmer.pl Unicode character database
lib/unicode/In/Lao.pl Unicode character database
lib/unicode/In/Latin-1Supplement.pl Unicode character database
lib/unicode/In/LatinExtended-A.pl Unicode character database
lib/unicode/In/MathematicalOperators.pl Unicode character database
lib/unicode/In/MiscellaneousSymbols.pl Unicode character database
lib/unicode/In/MiscellaneousTechnical.pl Unicode character database
+lib/unicode/In/Mongolian.pl Unicode character database
+lib/unicode/In/Myanmar.pl Unicode character database
lib/unicode/In/NumberForms.pl Unicode character database
+lib/unicode/In/Ogham.pl Unicode character database
lib/unicode/In/OpticalCharacterRecognition.pl Unicode character database
lib/unicode/In/Oriya.pl Unicode character database
lib/unicode/In/PrivateUse.pl Unicode character database
+lib/unicode/In/Runic.pl Unicode character database
+lib/unicode/In/Sinhala.pl Unicode character database
lib/unicode/In/SmallFormVariants.pl Unicode character database
lib/unicode/In/SpacingModifierLetters.pl Unicode character database
lib/unicode/In/Specials.pl Unicode character database
lib/unicode/In/SuperscriptsandSubscripts.pl Unicode character database
+lib/unicode/In/Syriac.pl Unicode character database
lib/unicode/In/Tamil.pl Unicode character database
lib/unicode/In/Telugu.pl Unicode character database
+lib/unicode/In/Thaana.pl Unicode character database
lib/unicode/In/Thai.pl Unicode character database
lib/unicode/In/Tibetan.pl Unicode character database
+lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl Unicode character database
+lib/unicode/In/YiRadicals.pl Unicode character database
+lib/unicode/In/YiSyllables.pl Unicode character database
+lib/unicode/Index.txt Unicode character database
lib/unicode/Is/ASCII.pl Unicode character database
lib/unicode/Is/Alnum.pl Unicode character database
lib/unicode/Is/Alpha.pl Unicode character database
lib/unicode/Is/SylC.pl Unicode character database
lib/unicode/Is/SylE.pl Unicode character database
lib/unicode/Is/SylI.pl Unicode character database
-lib/unicode/Is/Syllable.pl Unicode character database
lib/unicode/Is/SylO.pl Unicode character database
lib/unicode/Is/SylU.pl Unicode character database
lib/unicode/Is/SylV.pl Unicode character database
lib/unicode/Is/SylWE.pl Unicode character database
lib/unicode/Is/SylWI.pl Unicode character database
lib/unicode/Is/SylWV.pl Unicode character database
+lib/unicode/Is/Syllable.pl Unicode character database
lib/unicode/Is/Upper.pl Unicode character database
lib/unicode/Is/Word.pl Unicode character database
lib/unicode/Is/XDigit.pl Unicode character database
lib/unicode/Is/Zl.pl Unicode character database
lib/unicode/Is/Zp.pl Unicode character database
lib/unicode/Is/Zs.pl Unicode character database
+lib/unicode/Jamo.txt Unicode character database
lib/unicode/JamoShort.pl Unicode character database
+lib/unicode/LineBrk.txt Unicode character database
lib/unicode/Makefile Unicode character database
lib/unicode/Name.pl Unicode character database
+lib/unicode/Names.txt Unicode character database
+lib/unicode/NamesList.html Unicode character database
lib/unicode/Number.pl Unicode character database
+lib/unicode/Props.txt Unicode character database
lib/unicode/README.Ethiopic Unicode character database
+lib/unicode/ReadMe.txt Unicode character database info
+lib/unicode/SpecCase.txt Unicode character database
lib/unicode/To/Digit.pl Unicode character database
lib/unicode/To/Lower.pl Unicode character database
lib/unicode/To/Title.pl Unicode character database
lib/unicode/To/Upper.pl Unicode character database
-lib/unicode/UnicodeData-Latest.txt Unicode character database
-lib/unicode/ArabShap.txt Unicode character database
-lib/unicode/Blocks.txt Unicode character database
-lib/unicode/CompExcl.txt Unicode character database
-lib/unicode/EAWidth.txt Unicode character database
-lib/unicode/Index.txt Unicode character database
-lib/unicode/Jamo-2.txt Unicode character database
-lib/unicode/LineBrk.txt Unicode character database
+lib/unicode/UCD300.html Unicode character database
+lib/unicode/Unicode.300 Unicode character database
+lib/unicode/Unicode3.html Unicode character database
lib/unicode/mktables.PL Unicode character database generator
-lib/unicode/Names.txt Unicode character database
-lib/unicode/Props.txt Unicode character database
-lib/unicode/ReadMe.txt Unicode character database info
-lib/unicode/SpecCase.txt Unicode character database
lib/unicode/syllables.txt Unicode character database
-lib/unicode/Unicode.html Unicode character database
lib/utf8.pm Pragma to control Unicode support
lib/utf8_heavy.pl Support routines for utf8 pragma
lib/validate.pl Perl library supporting wholesale file mode validation
pod/perlfaq8.pod Frequently Asked Questions, Part 8
pod/perlfaq9.pod Frequently Asked Questions, Part 9
pod/perlfilter.pod Source filters info
+pod/perlfork.pod Info about fork()
pod/perlform.pod Format info
pod/perlfunc.pod Function info
pod/perlguts.pod Internals info
t/io/fs.t See if directory manipulations work
t/io/inplace.t See if inplace editing works
t/io/iprefix.t See if inplace editing works with prefixes
+t/io/nargv.t See if nested ARGV stuff works
t/io/open.t See if open works
t/io/openpid.t See if open works for subprocesses
t/io/pipe.t See if secure pipes work
t/lib/gdbm.t See if GDBM_File works
t/lib/getopt.t See if Getopt::Std and Getopt::Long work
t/lib/glob-basic.t See if File::Glob works
+t/lib/glob-case.t See if File::Glob works
t/lib/glob-global.t See if File::Glob works
t/lib/glob-taint.t See if File::Glob works
t/lib/gol-basic.t See if Getopt::Long works
win32/des_fcrypt.patch Win32 port
win32/dl_win32.xs Win32 port
win32/genmk95.pl Perl code to generate command.com-usable makew95.mk
+win32/gstartup.c GCC/Mingw32 runtime startup code
win32/include/arpa/inet.h Win32 port
win32/include/dirent.h Win32 port
win32/include/netdb.h Win32 port
win32/include/sys/socket.h Win32 port
-win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds)
+win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds)
+win32/oldnames.def Win32 DLL definition file for GCC-specific implib
+win32/PerlCRT.def Win32 DLL definition file for PerlCRT.dll
win32/perlglob.c Win32 port
+win32/perlhost.h Perl "host" implementation
win32/perllib.c Win32 port
win32/pod.mak Win32 port
win32/runperl.c Win32 port
win32/splittree.pl Win32 port
+win32/vdir.h Perl "host" virtual directory manager
+win32/vmem.h Perl "host" memory manager
win32/win32.c Win32 port
win32/win32.h Win32 port
win32/win32iop.h Win32 port
# how to tr(anslate) newlines
TRNL = '$trnl'
+# not used by Makefile but by installperl;
+# mentioned here so that metaconfig picks it up
+INSTALL_USR_BIN_PERL = $installusrbinperl
+
!GROK!THIS!
## In the following dollars and backticks do not need the extra backslash.
$(AR) rcu $(LIBPERL_NONSHR) perl$(OBJ_EXT) $(obj)
$(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT)
- $(CCCMD) $(PLDLFLAGS) -DMINIPERL_BUILD -o opmini$(OBJ_EXT) op.c
+ $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c
$(CC) $(LDFLAGS) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) \
opmini$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS)
# The Module used here must not depend on Config or any extensions.
miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)
- $(CCCMD) $(PLDLFLAGS) -DMINIPERL_BUILD -o opmini$(OBJ_EXT) op.c
+ $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c
$(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl \
miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs)
$(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
$(LDLIBPTH) ./miniperl -Ilib $@.PL
extra.pods: perl
+ -@test -f extra.pods && rm -f `cat extra.pods`
-@rm -f extra.pods
-@for x in `grep -l '^=[a-z]' README.*` ; do \
nx=`echo $$x | sed -e "s/README\.//"`; \
echo "pod/perl"$$nx".pod" >> extra.pods ; \
done
-install: all install.perl install.man extra.pods
+install: all install.perl install.man
-install.perl: all installperl
+install.perl: all extra.pods installperl
if [ -n "$(COMPILE)" ]; \
then \
cd utils; $(MAKE) compile; \
fi
$(LDLIBPTH) ./perl installperl
-install.man: all installman
+install.man: all extra.pods installman
$(LDLIBPTH) ./perl installman
# XXX Experimental. Hardwired values, but useful for testing.
'') perladmin='$perladmin' ;;
esac
-# Installation prefix. Allow a Configure -D override. You
+# 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
+case "\$siteprefix" in
+'') siteprefix='$siteprefix' ;;
+esac
+case "\$vendorprefix" in
+'') vendorprefix='$vendorprefix' ;;
+esac
+
+# Where installperl puts things.
+case "\$installprefix" in
+'') installprefix='$installprefix' ;;
+esac
# Installation directives. Note that each one comes in three flavors.
# For example, we have privlib, privlibexp, and installprivlib.
# 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.
+# 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
!GROK!THIS!
-for var in bin scriptdir privlib archlib \
- man1dir man3dir sitelib sitearch \
- installbin installscript installprivlib installarchlib \
- installman1dir installman3dir installsitelib installsitearch \
- man1ext man3ext; do
+for var in \
+ bin scriptdir privlib archlib man1dir man3dir html1dir html3dir \
+ sitebin sitescriptdir sitelib sitearch \
+ siteman1dir siteman3dir sitehtml1dir sitehtml3dir \
+ vendorbin vendorscript vendorlib vendorarch \
+ vendorman1 vendorman3 vendorhtml1 vendorhtml3
+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)
*) dflt=$prefix/lib/$package/$version ;;
esac
;;
- archlib)
- case "$prefix" in
- *perl*) dflt=$prefix/lib/$version/$archname ;;
- *) dflt=$prefix/lib/$package/$version/$archname ;;
- 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 ;;
+ # The scriptdir test is more complex, but this is probably usually ok.
+ sitescriptdir)
+ if $test -d $siteprefix/script; then
+ dflt=$siteprefix/script
+ else
+ dflt=$sitebin
+ fi
;;
sitelib)
- case "$prefix" in
- *perl*) dflt=$prefix/lib/site_perl/$apiversion ;;
- *) dflt=$prefix/lib/$package/site_perl/$apiversion ;;
- esac
- ;;
- sitearch)
- case "$prefix" in
- *perl*) dflt=$prefix/lib/site_perl/$apiversion/$archname ;;
- *) dflt=$prefix/lib/$package/site_perl/$apiversion/$archname ;;
- esac
- ;;
- man1dir) dflt="$prefix/man/man1" ;;
- man3dir)
- case "$prefix" in
- *perl*) dflt=`echo $man1dir |
- sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;;
- *) dflt=$privlib/man/man3 ;;
+ case "$siteprefix" in
+ *perl*) dflt=$prefix/lib/site_perl ;;
+ *) dflt=$prefix/lib/$package/site_perl ;;
esac
;;
+ sitearch) dflt="$sitelib/$apiversion/$archname" ;;
- # 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!^\.!!'` ;;
+ siteman1dir) dflt="$siteprefix/man/man1" ;;
+ siteman3dir) dflt="$siteprefix/man/man3" ;;
+ # We don't know what to do with these yet.
+ sitehtml1dir) 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 ;;
- # It might be possible to fool these next tests. Please let
- # me know if they don't work right for you.
- installbin) dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;;
- installscript) dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;;
- installprivlib) dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;;
- installarchlib) dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;;
- installsitelib) dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
- installsitearch) dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;;
- installman1dir) dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;;
- installman3dir) dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;;
+ # The scriptdir test is more complex,
+ # but this is probably usually ok.
+ vendorscriptdir)
+ if $test -d $vendorprefix/script; then
+ dflt=$vendorprefix/script
+ else
+ dflt=$vendorbin
+ fi
+ ;;
+ vendorlib)
+ case "$vendorprefix" in
+ *perl*) dflt=$prefix/lib/vendor_perl ;;
+ *) dflt=$prefix/lib/$package/vendor_perl ;;
+ esac
+ ;;
+ vendorarch) dflt="$vendorlib/$apiversion/$archname" ;;
+
+ vendorman1dir) dflt="$vendorprefix/man/man1" ;;
+ vendorman3dir) dflt="$vendorprefix/man/man3" ;;
+ # We don't know what to do with these yet.
+ vendorhtml1dir) dflt='' ;;
+ vendorhtm31dir) dflt='' ;;
+
+ esac # End of vendorprefix != ''
+ fi
+ ;;
esac
eval val="\$$var"
# 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@lafcol.lafayette.edu>.
+# Andy Dougherty <doughera@lafayette.edu>.
# This file may be distributed under the same terms as Perl itself.
-
generates pod documentation for Config.pm from this file--please try to keep
the formatting regular.]
+CONFIGDOTSH (Oldsyms.U):
+ This is set to 'true' in config.sh so that a shell script
+ sourcing config.sh can tell if it has been sourced already.
+
+Mcc (Loc.U):
+ This variable is used internally by Configure to determine the
+ full pathname (if any) of the Mcc program. After Configure runs,
+ the value is reset to a plain "Mcc" and is not useful.
+
+PERL_APIVERSION (Oldsyms.U):
+ This value is manually set in patchlevel.h and is used
+ to set the Configure apiversion variable.
+
+PERL_REVISION (Oldsyms.U):
+ In a Perl version number such as 5.6.2, this is the 5.
+ This value is manually set in patchlevel.h
+
+PERL_SUBVERSION (Oldsyms.U):
+ In a Perl version number such as 5.6.2, this is the 2.
+ Values greater than 50 represent potentially unstable
+ development subversions.
+ This value is manually set in patchlevel.h
+
+PERL_VERSION (Oldsyms.U):
+ In a Perl version number such as 5.6.2, this is the 6.
+ This value is manually set in patchlevel.h
+
_a (Unix.U):
This variable defines the extension used for ordinary libraries.
For unix, it is '.a'. The '.' is included. Other possible
Holds the output of the "date" command when the configuration file was
produced. This is used to tag both config.sh and config_h.SH.
+charsize (charsize.U):
+ This variable contains the value of the CHARSIZE symbol, which
+ indicates to the C program how many bytes there are in a character.
+
chgrp (Loc.U):
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
full pathname (if any) of the csh program. After Configure runs,
the value is reset to a plain "csh" and is not useful.
+d_Gconvert (d_gconvert.U):
+ This variable holds what Gconvert is defined as to convert
+ floating point numbers into strings. It could be 'gconvert'
+ or a more complex macro emulating gconvert with gcvt() or sprintf.
+ Possible values are:
+ d_Gconvert='gconvert((x),(n),(t),(b))'
+ d_Gconvert='gcvt((x),(n),(b))'
+ d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+
+d_PRIEldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIFldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIGldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIX64 (quadfio.U):
+ This variable conditionally defines the PERL_PRIX64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit hExADECimAl numbers.
+
+d_PRId64 (quadfio.U):
+ This variable conditionally defines the PERL_PRId64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit decimal numbers.
+
+d_PRIeldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIfldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIgldbl (longdblfio.U):
+ This variable conditionally defines the PERL_PRIfldlbl symbol, which
+ indiciates that stdio has a symbol to print long doubles.
+
+d_PRIi64 (quadfio.U):
+ This variable conditionally defines the PERL_PRIi64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit decimal numbers.
+
+d_PRIo64 (quadfio.U):
+ This variable conditionally defines the PERL_PRIo64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit octal numbers.
+
+d_PRIu64 (quadfio.U):
+ This variable conditionally defines the PERL_PRIu64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit unsigned decimal
+ numbers.
+
+d_PRIx64 (quadfio.U):
+ This variable conditionally defines the PERL_PRIx64 symbol, which
+ indiciates that stdio has a symbol to print 64-bit hexadecimal numbers.
+
d_access (d_access.U):
This variable conditionally defines HAS_ACCESS if the access() system
call is available to check for access permissions using real IDs.
This variable conditionally defines HAS_CLOSEDIR if closedir() is
available.
-d_cmsghdr_s (d_socket.U):
- This variable conditionally defines the HAS_STRUCT_CMSGHDR symbol,
- which indicates that the the struct cmsghdr is supported.
-
d_const (d_const.U):
This variable conditionally defines the HASCONST symbol, which
indicates to the C program that this C compiler knows about the
d_fpos64_t (io64.U):
This symbol will be defined if the C compiler supports fpos64_t.
+d_fs_data_s (d_fs_data_s.U):
+ This variable conditionally defines the HAS_STRUCT_FS_DATA symbol,
+ which indicates that the struct fs_data is supported.
+
d_fseeko (d_fseeko.U):
This variable conditionally defines the HAS_FSEEKO symbol, which
indicates to the C program that the fseeko() routine is available.
This variable conditionally defines HAS_FSETPOS if fsetpos() is
available to set the file position indicator.
-d_fstatfs (d_statfs.U):
+d_fstatfs (d_fstatfs.U):
This variable conditionally defines the HAS_FSTATFS symbol, which
indicates to the C program that the fstatfs() routine is available.
that the ftime() routine exists. The ftime() routine is basically
a sub-second accuracy clock.
-d_Gconvert (d_gconvert.U):
- This variable holds what Gconvert is defined as to convert
- floating point numbers into strings. It could be 'gconvert'
- or a more complex macro emulating gconvert with gcvt() or sprintf.
- Possible values are:
- d_Gconvert='gconvert((x),(n),(t),(b))'
- d_Gconvert='gcvt((x),(n),(b))'
- d_Gconvert='sprintf((b),"%.*g",(n),(x))'
-
d_getgrent (d_getgrent.U):
This variable conditionally defines the HAS_GETGRENT symbol, which
indicates to the C program that the getgrent() routine is available
indicates to the C program that the getlogin() routine is available
to get the login name.
+d_getmnt (d_getmnt.U):
+ This variable conditionally defines the HAS_GETMNT symbol, which
+ indicates to the C program that the getmnt() routine is available
+ to retrieve one or more mount info blocks by filename.
+
d_getmntent (d_getmntent.U):
This variable conditionally defines the HAS_GETMNTENT symbol, which
indicates to the C program that the getmntent() routine is available
- to iterate through mounted files.
+ to iterate through mounted files to get their mount info.
d_getnbyaddr (d_getnbyad.U):
This variable conditionally defines the HAS_GETNETBYADDR symbol, which
indicates to the C program that the inet_aton() function is available
to parse IP address "dotted-quad" strings.
-d_int64t (i_inttypes.U):
+d_int64t (d_int64t.U):
This symbol will be defined if the C compiler supports int64_t.
-d_iovec_s (i_sysuio.U):
- This variable conditionally defines the HAS_STRUCT_IOVEC symbol,
- which indicates that the struct iovec is supported.
-
d_isascii (d_isascii.U):
This variable conditionally defines the HAS_ISASCII constant,
which indicates to the C program that isascii() is available.
This variable conditionally defines HAS_LINK if link() is
available to create hard links.
-d_llseek (io64.U):
- This variable conditionally defines the HAS_LLSEEK symbol, which
- indicates to the C program that the llseek() routine is available.
-
d_locconv (d_locconv.U):
This variable conditionally defines HAS_LOCALECONV if localeconv() is
available for numeric and monetary formatting conventions.
This variable conditionally defines HAS_LSTAT if lstat() is
available to do file stats on symbolic links.
-d_madvise (d_madvise.U):
- This variable conditionally defines HAS_MADVISE if madvise() is
- available to map a file into memory.
-
d_mblen (d_mblen.U):
This variable conditionally defines the HAS_MBLEN symbol, which
indicates to the C program that the mblen() routine is available
This variable conditionally defines the HAS_MKTIME symbol, which
indicates to the C program that the mktime() routine is available.
-d_mmap (d_mmap.U):
- This variable conditionally defines HAS_MMAP if mmap() is
- available to map a file into memory.
-
-d_mprotect (d_mprotect.U):
- This variable conditionally defines HAS_MPROTECT if mprotect() is
- available to modify the access protection of a memory mapped file.
-
d_msg (d_msg.U):
This variable conditionally defines the HAS_MSG symbol, which
indicates that the entire msg*(2) library is present.
This variable conditionally defines the HAS_MSGGET symbol, which
indicates to the C program that the msgget() routine is available.
-d_msghdr_s (d_socket.U):
- This variable conditionally defines the HAS_STRUCT_MSGHDR symbol,
- which indicates that the struct msghdr is supported.
-
d_msgrcv (d_msgrcv.U):
This variable conditionally defines the HAS_MSGRCV symbol, which
indicates to the C program that the msgrcv() routine is available.
This variable conditionally defines the HAS_MSGSND symbol, which
indicates to the C program that the msgsnd() routine is available.
-d_msync (d_msync.U):
- This variable conditionally defines HAS_MSYNC if msync() is
- available to synchronize a mapped file.
-
-d_munmap (d_munmap.U):
- This variable conditionally defines HAS_MUNMAP if munmap() is
- available to unmap a region mapped by mmap().
-
d_mymalloc (mallocsrc.U):
This variable conditionally defines MYMALLOC in case other parts
of the source want to take special action if MYMALLOC is used.
indicates to the C program that it should not assume that it is
running on the machine it was compiled on.
-d_PRId64 (quadfio.U):
- This variable conditionally defines the PERL_PRId64 symbol, which
- indiciates that stdio has a symbol to print 64-bit decimal numbers.
-
-d_PRIeldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIEldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIfldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIFldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIgldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIGldbl (longdblfio.U):
- This variable conditionally defines the PERL_PRIfldlbl symbol, which
- indiciates that stdio has a symbol to print long doubles.
-
-d_PRIi64 (quadfio.U):
- This variable conditionally defines the PERL_PRIi64 symbol, which
- indiciates that stdio has a symbol to print 64-bit decimal numbers.
-
-d_PRIo64 (quadfio.U):
- This variable conditionally defines the PERL_PRIo64 symbol, which
- indiciates that stdio has a symbol to print 64-bit octal numbers.
-
-d_PRIu64 (quadfio.U):
- This variable conditionally defines the PERL_PRIu64 symbol, which
- indiciates that stdio has a symbol to print 64-bit unsigned decimal
- numbers.
-
-d_PRIx64 (quadfio.U):
- This variable conditionally defines the PERL_PRIx64 symbol, which
- indiciates that stdio has a symbol to print 64-bit hexadecimal numbers.
-
-d_PRIX64 (quadfio.U):
- This variable conditionally defines the PERL_PRIX64 symbol, which
- indiciates that stdio has a symbol to print 64-bit hExADECimAl numbers.
-
d_pthread_yield (d_pthread_y.U):
This variable conditionally defines the HAS_PTHREAD_YIELD
symbol if the pthread_yield routine is available to yield
This variable conditionally defines PWQUOTA, which indicates
that struct passwd contains pw_quota.
+d_quad (quadtype.U):
+ This variable, if defined, tells that there's a 64-bit integer type,
+ quadtype.
+
d_readdir (d_readdir.U):
This variable conditionally defines HAS_READDIR if readdir() is
available to read directory entries.
indicates to the C program that the readlink() routine is available
to read the value of a symbolic link.
-d_readv (d_readv.U):
- This variable conditionally defines the HAS_READV symbol, which
- indicates to the C program that the readv() routine is available.
-
-d_recvmsg (d_socket.U):
- This variable conditionally defines the HAS_RECVMSG symbol,
- which indicates that the recvmsg is supported.
-
d_rename (d_rename.U):
This variable conditionally defines the HAS_RENAME symbol, which
indicates to the C program that the rename() routine is available
This variable conditionally defines the HAS_SEMOP symbol, which
indicates to the C program that the semop() routine is available.
-d_sendmsg (d_socket.U):
- This variable conditionally defines the HAS_SENDMSG symbol,
- which indicates that the sendmsg is supported.
-
d_setegid (d_setegid.U):
This variable conditionally defines the HAS_SETEGID symbol, which
indicates to the C program that the setegid() routine is available
This variable conditionally defines the HAS_SOCKETPAIR symbol, which
indicates that the BSD socketpair() is supported.
+d_sqrtl (d_sqrtl.U):
+ This variable conditionally defines the HAS_SQRTL symbol, which
+ indicates to the C program that the sqrtl() routine is available.
+
d_statblks (d_statblks.U):
This variable conditionally defines USE_STAT_BLOCKS
if this system has a stat structure declaring
st_blksize and st_blocks.
-d_statfs (d_statfs.U):
- This variable conditionally defines the HAS_STATFS symbol, which
- indicates to the C program that the statfs() routine is available.
-
-d_statfsflags (d_statfs.U):
- This variable conditionally defines the HAS_STRUCT_STATFS_FLAGS
+d_statfs_f_flags (d_statfs_f_flags.U):
+ This variable conditionally defines the HAS_STRUCT_STATFS_F_FLAGS
symbol, which indicates to struct statfs from has f_flags member.
This kind of struct statfs is coming from sys/mount.h (BSD),
not from sys/statfs.h (SYSV).
+d_statfs_s (d_statfs_s.U):
+ This variable conditionally defines the HAS_STRUCT_STATFS symbol,
+ which indicates that the struct statfs is supported.
+
d_statvfs (d_statvfs.U):
This variable conditionally defines the HAS_STATVFS symbol, which
indicates to the C program that the statvfs() routine is available.
This variable conditionally defines HAS_UNION_SEMUN if the
union semun is defined by including <sys/sem.h>.
+d_ustat (d_ustat.U):
+ This variable conditionally defines HAS_USTAT if ustat() is
+ available to query file system statistics by dev_t.
+
+d_vendorbin (vendorbin.U):
+ This variable conditionally defines PERL_VENDORBIN.
+
d_vendorlib (vendorlib.U):
This variable conditionally defines PERL_VENDORLIB.
indicates to the C program that the wctomb() routine is available
to convert a wide character to a multibyte.
-d_writev (d_writev.U):
- This variable conditionally defines the HAS_WRITEV symbol, which
- indicates to the C program that the writev() routine is available.
-
d_xenix (Guess.U):
This variable conditionally defines the symbol XENIX, which alerts
the C program that it runs under Xenix.
and is typically used to test whether a particular extesion
is available.
+fflushNULL (fflushall.U):
+ This symbol, if defined, tells that fflush(NULL) does flush
+ all pending stdio output.
+
fflushall (fflushall.U):
This symbol, if defined, tells that to flush
all pending stdio output one must loop through all
Note that if fflushNULL is defined, fflushall will not
even be probed for and will be left undefined.
-fflushNULL (fflushall.U):
- This symbol, if defined, tells that fflush(NULL) does flush
- all pending stdio output.
-
find (Loc.U):
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
+fpossize (fpossize.U):
+ This variable contains the size of a fpostype in bytes.
+
fpostype (fpostype.U):
- This variable defines Fpos_t to be something like fpost_t, long,
+ This variable defines Fpos_t to be something like fpos_t, long,
uint, or whatever type is used to declare file positions in libc.
freetype (mallocsrc.U):
indicate whether the compiler is version 1 or 2. This is used in
setting some of the default cflags. It is set to '' if not gcc.
+gidformat (gidf.U):
+ This variable contains the format string used for printing a Gid_t.
+
+gidsign (gidsign.U):
+ This variable contains the signedness of a gidtype.
+ 1 for unsigned, -1 for signed.
+
+gidsize (gidsize.U):
+ This variable contains the size of a gidtype in bytes.
+
gidtype (gidtype.U):
This variable defines Gid_t to be something like gid_t, int,
ushort, or whatever type is used to declare the return type
huge model is not supported, contains the flag to produce large
model programs. It is up to the Makefile to use this.
+i16size (perlxv.U):
+ This variable is the size of an I16 in bytes.
+
+i16type (perlxv.U):
+ This variable contains the C type used for Perl's I16.
+
+i32size (perlxv.U):
+ This variable is the size of an I32 in bytes.
+
+i32type (perlxv.U):
+ This variable contains the C type used for Perl's I32.
+
+i64size (perlxv.U):
+ This variable is the size of an I64 in bytes.
+
+i64type (perlxv.U):
+ This variable contains the C type used for Perl's I64.
+
+i8size (perlxv.U):
+ This variable is the size of an I8 in bytes.
+
+i8type (perlxv.U):
+ This variable contains the C type used for Perl's I8.
+
i_arpainet (i_arpainet.U):
This variable conditionally defines the I_ARPA_INET symbol,
and indicates whether a C program should include <arpa/inet.h>.
indicates to the C program that <sys/ioctl.h> exists and should
be included.
-i_sysmman (i_sysmman.U):
- This variable conditionally defines the I_SYS_MMAN symbol, and
- indicates whether a C program should include <sys/mman.h>.
-
i_sysmount (i_sysmount.U):
This variable conditionally defines the I_SYSMOUNT symbol,
and indicates whether a C program should include <sys/mount.h>.
This variable conditionally defines the I_SYS_STAT symbol,
and indicates whether a C program should include <sys/stat.h>.
+i_sysstatfs (i_sysstatfs.U):
+ This variable conditionally defines the I_SYSSTATFS symbol,
+ and indicates whether a C program should include <sys/statfs.h>.
+
i_sysstatvfs (i_sysstatvfs.U):
This variable conditionally defines the I_SYSSTATVFS symbol,
and indicates whether a C program should include <sys/statvfs.h>.
to the C program that it should include <sys/un.h> to get UNIX
domain socket definitions.
+i_sysvfs (i_sysvfs.U):
+ This variable conditionally defines the I_SYSVFS symbol,
+ and indicates whether a C program should include <sys/vfs.h>.
+
i_syswait (i_syswait.U):
This variable conditionally defines I_SYS_WAIT, which indicates
to the C program that it should include <sys/wait.h>.
This variable conditionally defines the I_UNISTD symbol, and indicates
whether a C program should include <unistd.h>.
+i_ustat (i_ustat.U):
+ This variable conditionally defines the I_USTAT symbol, and indicates
+ whether a C program should include <ustat.h>.
+
i_utime (i_utime.U):
This variable conditionally defines the I_UTIME symbol, and indicates
whether a C program should include <utime.h>.
those systems using AFS. For extra portability, only this variable
should be used in makefiles.
+installsitebin (sitebin.U):
+ This variable is usually the same as sitebinexp, unless you are on
+ a system running AFS, in which case they may differ slightly. You
+ should always use this variable within your makefiles for portability.
+
installsitelib (sitelib.U):
This variable is really the same as sitelibexp but may differ on
those systems using AFS. For extra portability, only this variable
/usr/bin/perl in addition to
$installbin/perl
+installvendorbin (vendorbin.U):
+ This variable is really the same as vendorbinexp but may differ on
+ those systems using AFS. For extra portability, only this variable
+ should be used in makefiles.
+
installvendorlib (vendorlib.U):
This variable is really the same as vendorlibexp but may differ on
those systems using AFS. For extra portability, only this variable
This variable contains the value of the INTSIZE symbol, which
indicates to the C program how many bytes there are in an int.
+ivdformat (perlxvf.U):
+ This variable contains the format string used for printing
+ a Perl IV as a signed decimal integer.
+
+ivsize (perlxv.U):
+ This variable is the size of an IV in bytes.
+
+ivtype (perlxv.U):
+ This variable contains the C type used for Perl's IV.
+
known_extensions (Extensions.U):
This variable holds a list of all XS extensions included in
the package.
have: one of 'n', 'l', or '3'. The Makefile must supply the '.'.
See man3dir.
-Mcc (Loc.U):
- This variable is used internally by Configure to determine the
- full pathname (if any) of the Mcc program. After Configure runs,
- the value is reset to a plain "Mcc" and is not useful.
-
medium (models.U):
This variable contains a flag which will tell the C compiler and loader
to produce a program running with a medium memory model. If the
full pathname (if any) of the mkdir program. After Configure runs,
the value is reset to a plain "mkdir" and is not useful.
-mmaptype (d_mmap.U):
- This symbol contains the type of pointer returned by mmap()
- (and simultaneously the type of the first argument).
- It can be 'void *' or 'caddr_t'.
-
models (models.U):
This variable contains the list of memory models supported by this
system. Possible component values are none, split, unsplit, small,
full pathname (if any) of the nroff program. After Configure runs,
the value is reset to a plain "nroff" and is not useful.
+nvsize (perlxv.U):
+ This variable is the size of an NV in bytes.
+
+nvtype (perlxv.U):
+ This variable contains the C type used for Perl's NV.
+
o_nonblock (nblock_io.U):
This variable bears the symbol value to be used during open() or fcntl()
to turn on non-blocking I/O for a file descriptor. If you wish to switch
This variable contains the value of the PTRSIZE symbol, which
indicates to the C program how many bytes there are in a pointer.
+quadkind (quadtype.U):
+ This variable, if defined, encodes the type of a quad:
+ 1 = int, 2 = long, 3 = long long, 4 = int64_t.
+
+quadtype (quadtype.U):
+ This variable defines Quad_t to be something like long, int,
+ long long, int64_t, or whatever type is used for 64-bit integers.
+
randbits (randfunc.U):
Indicates how many bits are produced by the function used to
generate normalized random numbers.
nm extraction should be performed or not, according to the value
of usenm and the flags on the Configure command line.
+sPRIEldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'E') for output.
+
+sPRIFldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'F') for output.
+
+sPRIGldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'G') for output.
+
+sPRIX64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit hExADECimAl numbers (format 'X') for output.
+
+sPRId64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit decimal numbers (format 'd') for output.
+
+sPRIeldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'e') for output.
+
+sPRIfldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'f') for output.
+
+sPRIgldbl (longdblfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format long doubles (format 'g') for output.
+
+sPRIi64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit decimal numbers (format 'i') for output.
+
+sPRIo64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit octal numbers (format 'o') for output.
+
+sPRIu64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit unsigned decimal numbers (format 'u') for output.
+
+sPRIx64 (quadfio.U):
+ This variable, if defined, contains the string used by stdio to
+ format 64-bit hexadecimal numbers (format 'x') for output.
+
sched_yield (d_pthread_y.U):
This variable defines the way to yield the execution
of the current thread.
which is the name of the private library for this package. It may
have a ~ on the front. It is up to the makefile to eventually create
this directory while performing installation (with ~ substitution).
+ The standard distribution will put nothing in this directory.
+ After perl has been installed, users may install their own local
+ architecture-dependent modules in this directory with
+ MakeMaker Makefile.PL
+ or equivalent. See INSTALL for details.
sitearchexp (sitearch.U):
This variable is the ~name expanded version of sitearch, so that you
may use it directly in Makefiles or shell scripts.
+sitebin (sitebin.U):
+ This variable holds the name of the directory in which the user wants
+ to put add-on publicly executable files for the package in question. It
+ is most often a local directory such as /usr/local/bin. Programs using
+ this variable must be prepared to deal with ~name substitution.
+ The standard distribution will put nothing in this directory.
+ After perl has been installed, users may install their own local
+ executables in this directory with
+ MakeMaker Makefile.PL
+ or equivalent. See INSTALL for details.
+
+sitebinexp (sitebin.U):
+ This is the same as the sitebin variable, but is filename expanded at
+ configuration time, for use in your makefiles.
+
sitelib (sitelib.U):
This variable contains the eventual value of the SITELIB symbol,
which is the name of the private library for this package. It may
have a ~ on the front. It is up to the makefile to eventually create
this directory while performing installation (with ~ substitution).
+ The standard distribution will put nothing in this directory.
+ After perl has been installed, users may install their own local
+ architecture-independent modules in this directory with
+ MakeMaker Makefile.PL
+ or equivalent. See INSTALL for details.
sitelibexp (sitelib.U):
This variable is the ~name expanded version of sitelib, so that you
siteprefix (siteprefix.U):
This variable holds the full absolute path of the directory below
which the user will install add-on packages.
+ See INSTALL for usage and examples.
siteprefixexp (siteprefix.U):
This variable holds the full absolute path of the directory below
which the user will install add-on packages. Derived from siteprefix.
+sizesize (sizesize.U):
+ This variable contains the size of a sizetype in bytes.
+
sizetype (sizetype.U):
This variable defines sizetype to be something like size_t,
unsigned long, or whatever type is used to declare length
machines that support separation of instruction and data space. It is
up to the Makefile to use this.
-sPRId64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit decimal numbers (format 'd') for output.
-
-sPRIeldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'e') for output.
-
-sPRIEldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'E') for output.
-
-sPRIfldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'f') for output.
-
-sPRIFldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'F') for output.
-
-sPRIgldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'g') for output.
-
-sPRIGldbl (longdblfio.U):
- This variable, if defined, contains the string used by stdio to
- format long doubles (format 'G') for output.
-
-sPRIi64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit decimal numbers (format 'i') for output.
-
-sPRIo64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit octal numbers (format 'o') for output.
-
-sPRIu64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit unsigned decimal numbers (format 'u') for output.
-
-sPRIx64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit hexadecimal numbers (format 'x') for output.
-
-sPRIX64 (quadfio.U):
- This variable, if defined, contains the string used by stdio to
- format 64-bit hExADECimAl numbers (format 'X') for output.
-
src (src.U):
This variable holds the path to the package source. It is up to
the Makefile to use this variable and set VPATH accordingly to
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
+u16size (perlxv.U):
+ This variable is the size of an U16 in bytes.
+
+u16type (perlxv.U):
+ This variable contains the C type used for Perl's U16.
+
+u32size (perlxv.U):
+ This variable is the size of an U32 in bytes.
+
+u32type (perlxv.U):
+ This variable contains the C type used for Perl's U32.
+
+u64size (perlxv.U):
+ This variable is the size of an U64 in bytes.
+
+u64type (perlxv.U):
+ This variable contains the C type used for Perl's U64.
+
+u8size (perlxv.U):
+ This variable is the size of an U8 in bytes.
+
+u8type (perlxv.U):
+ This variable contains the C type used for Perl's U8.
+
+uidformat (uidf.U):
+ This variable contains the format string used for printing a Uid_t.
+
uidsign (uidsign.U):
This variable contains the signedness of a uidtype.
1 for unsigned, -1 for signed.
+uidsize (uidsize.U):
+ This variable contains the size of a uidtype in bytes.
+
uidtype (uidtype.U):
This variable defines Uid_t to be something like uid_t, int,
ushort, or whatever type is used to declare user ids in the kernel.
full pathname (if any) of the uniq program. After Configure runs,
the value is reset to a plain "uniq" and is not useful.
+uquadtype (quadtype.U):
+ This variable defines Uquad_t to be something like unsigned long,
+ unsigned int, unsigned long long, uint64_t, or whatever type is
+ used for 64-bit integers.
+
use64bits (use64bits.U):
This variable conditionally defines the USE_64_BITS symbol,
and indicates that explicit 64-bit interfaces should be used
This variable conditionally defines the USE_LONG_DOUBLE symbol,
and indicates that long doubles should be used when available.
+uselonglong (uselonglong.U):
+ This variable conditionally defines the USE_LONG_LONG symbol,
+ and indicates that long longs should be used when available.
+
usemorebits (usemorebits.U):
This variable conditionally defines the USE_MORE_BITS symbol,
and indicates that explicit 64-bit interfaces and long doubles
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
+uvoformat (perlxvf.U):
+ This variable contains the format string used for printing
+ a Perl UV as an unsigned octal integer.
+
+uvsize (perlxv.U):
+ This variable is the size of a UV in bytes.
+
+uvtype (perlxv.U):
+ This variable contains the C type used for Perl's UV.
+
+uvuformat (perlxvf.U):
+ This variable contains the format string used for printing
+ a Perl UV as an unsigned decimal integer.
+
+uvxformat (perlxvf.U):
+ This variable contains the format string used for printing
+ a Perl UV as an unsigned hexadecimal integer.
+
+vendorbin (vendorbin.U):
+ This variable contains the eventual value of the VENDORBIN symbol.
+ It may have a ~ on the front.
+ The standard distribution will put nothing in this directory.
+ Vendors who distribute perl may wish to place additional
+ binaries in this directory with
+ MakeMaker Makefile.PL INSTALLDIRS=vendor
+ or equivalent. See INSTALL for details.
+
+vendorbinexp (vendorbin.U):
+ This variable is the ~name expanded version of vendorbin, so that you
+ may use it directly in Makefiles or shell scripts.
+
vendorlib (vendorlib.U):
This variable contains the eventual value of the VENDORLIB symbol,
- which is the name of the private library for this package. It may
- have a ~ on the front. It is up to the makefile to eventually create
- this directory while performing installation (with ~ substitution).
- Vendors who distribute perl binaries may place their own
- extensions and modules in this directory.
+ which is the name of the private library for this package.
+ The standard distribution will put nothing in this directory.
+ Vendors who distribute perl may wish to place their own
+ modules in this directory with
+ MakeMaker Makefile.PL INSTALLDIRS=vendor
+ or equivalent. See INSTALL for details.
vendorlibexp (vendorlib.U):
This variable is the ~name expanded version of vendorlib, so that you
vendorprefix (vendorprefix.U):
This variable holds the full absolute path of the directory below
which the vendor will install add-on packages.
+ See INSTALL for usage and examples.
vendorprefixexp (vendorprefix.U):
This variable holds the full absolute path of the directory below
# Package name : perl5
# Source directory : .
-# Configuration time: Sun Oct 3 02:17:38 EET DST 1999
+# Configuration time: Sat Nov 13 15:28:21 EET 1999
# Configured by : jhi
# Target system : osf1 alpha.hut.fi v4.0 878 alpha
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='5.00561'
+apiversion='5.00563'
ar='ar'
-archlib='/opt/perl/lib/5.00561/alpha-dec_osf-thread'
-archlibexp='/opt/perl/lib/5.00561/alpha-dec_osf-thread'
+archlib='/opt/perl/lib/5.00563/alpha-dec_osf-thread'
+archlibexp='/opt/perl/lib/5.00563/alpha-dec_osf-thread'
archname64=''
archname='alpha-dec_osf-thread'
archobjs=''
cat='cat'
cc='cc'
cccdlflags=' '
-ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.00561/alpha-dec_osf-thread/CORE'
+ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.00563/alpha-dec_osf-thread/CORE'
ccflags='-pthread -std -DLANGUAGE_C'
-ccsymbols='__LANGUAGE_C__=1 _LONGLONG=1 LANGUAGE_C=1 SYSTYPE_BSD=1'
+ccsymbols='LANGUAGE_C=1 SYSTYPE_BSD=1 _LONGLONG=1 __LANGUAGE_C__=1'
cf_by='jhi'
cf_email='yourname@yourhost.yourplace.com'
-cf_time='Sun Oct 3 02:17:38 EET DST 1999'
+cf_time='Sat Nov 13 15:28:21 EET 1999'
+charsize='1'
chgrp=''
chmod=''
chown=''
cpio=''
cpp='cpp'
cpp_stuff='42'
-cppccsymbols='__alpha=1 __osf__=1 __unix__=1 _SYSTYPE_BSD=1 unix=1'
+cppccsymbols='_SYSTYPE_BSD=1 __alpha=1 __osf__=1 __unix__=1 unix=1'
cppflags='-pthread -std -DLANGUAGE_C'
cpplast=''
cppminus=''
d_chroot='define'
d_chsize='undef'
d_closedir='define'
-d_cmsghdr_s='define'
d_const='define'
d_crypt='define'
d_csh='define'
d_fork='define'
d_fpathconf='define'
d_fpos64_t='undef'
+d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='define'
d_fstatfs='define'
d_gethname='define'
d_gethostprotos='define'
d_getlogin='define'
+d_getmnt='undef'
d_getmntent='undef'
d_getnbyaddr='define'
d_getnbyname='define'
d_index='undef'
d_inetaton='define'
d_int64t='undef'
-d_iovec_s='define'
d_isascii='define'
d_killpg='define'
d_lchown='define'
d_ldbl_dig='define'
d_link='define'
-d_llseek='undef'
d_locconv='define'
d_lockf='define'
d_longdbl='define'
d_longlong='define'
d_lstat='define'
-d_madvise='define'
d_mblen='define'
d_mbstowcs='define'
d_mbtowc='define'
d_mkdir='define'
d_mkfifo='define'
d_mktime='define'
-d_mmap='define'
-d_mprotect='define'
d_msg='define'
d_msg_ctrunc='define'
d_msg_dontroute='define'
d_msg_proxy='undef'
d_msgctl='define'
d_msgget='define'
-d_msghdr_s='define'
d_msgrcv='define'
d_msgsnd='define'
-d_msync='define'
-d_munmap='define'
d_mymalloc='undef'
d_nice='define'
d_off64_t='undef'
d_pwgecos='define'
d_pwpasswd='define'
d_pwquota='define'
+d_quad='define'
d_readdir='define'
d_readlink='define'
-d_readv='define'
-d_recvmsg='define'
d_rename='define'
d_rewinddir='define'
d_rmdir='define'
d_semctl_semun='define'
d_semget='define'
d_semop='define'
-d_sendmsg='define'
d_setegid='define'
d_seteuid='define'
d_setgrent='define'
d_sigsetjmp='define'
d_socket='define'
d_sockpair='define'
+d_sqrtl='define'
d_statblks='define'
-d_statfs='define'
-d_statfsflags='define'
+d_statfs_f_flags='define'
+d_statfs_s='define'
d_statvfs='define'
d_stdio_cnt_lval='define'
d_stdio_ptr_lval='define'
d_umask='define'
d_uname='define'
d_union_semun='undef'
+d_ustat='define'
+d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
d_void_closedir='undef'
d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
-d_writev='define'
d_xenix='undef'
date='date'
db_hashtype='u_int32_t'
dlsrc='dl_dlopen.xs'
doublesize='8'
drand01='drand48()'
-dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
+dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
eagain='EAGAIN'
ebcdic='undef'
echo='echo'
eunicefix=':'
exe_ext=''
expr='expr'
-extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno'
+extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno'
fflushNULL='define'
fflushall='undef'
find=''
firstmakefile='makefile'
flex=''
+fpossize='8'
fpostype='fpos_t'
freetype='void'
full_ar='/usr/bin/ar'
full_csh='/usr/bin/csh'
full_sed='/usr/bin/sed'
gccversion=''
+gidformat='"u"'
+gidsign='1'
+gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib'
grep='grep'
hint='recommended'
hostcat='cat /etc/hosts'
huge=''
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='int'
+i64size='8'
+i64type='long'
+i8size='1'
+i8type='char'
i_arpainet='define'
i_bsdioctl=''
i_db='define'
i_sysfilio='undef'
i_sysin='undef'
i_sysioctl='define'
-i_sysmman='define'
i_sysmount='define'
i_sysndir='undef'
i_sysparam='define'
i_sysselct='define'
i_syssockio=''
i_sysstat='define'
+i_sysstatfs='undef'
i_sysstatvfs='define'
i_systime='define'
i_systimek='undef'
i_systypes='define'
i_sysuio='define'
i_sysun='define'
+i_sysvfs='undef'
i_syswait='define'
i_termio='undef'
i_termios='define'
i_time='undef'
i_unistd='define'
+i_ustat='define'
i_utime='define'
i_values='define'
i_varargs='undef'
ignore_versioned_solibs=''
incpath=''
inews=''
-installarchlib='/opt/perl/lib/5.00561/alpha-dec_osf-thread'
+installarchlib='/opt/perl/lib/5.00563/alpha-dec_osf-thread'
installbin='/opt/perl/bin'
installman1dir='/opt/perl/man/man1'
installman3dir='/opt/perl/man/man3'
installprefix='/opt/perl'
installprefixexp='/opt/perl'
-installprivlib='/opt/perl/lib/5.00561'
+installprivlib='/opt/perl/lib/5.00563'
installscript='/opt/perl/bin'
-installsitearch='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread'
+installsitearch='/opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread'
+installsitebin='/opt/perl/bin'
installsitelib='/opt/perl/lib/site_perl'
installstyle='lib'
installusrbinperl='define'
+installvendorbin=''
installvendorlib=''
intsize='4'
-known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
+ivdformat='"ld"'
+ivsize='8'
+ivtype='long'
+known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
ksh=''
large=''
ld='ld'
man3direxp='/opt/perl/man/man3'
man3ext='3'
medium=''
-mips=''
mips_type=''
mkdir='mkdir'
-mmaptype='void *'
models='none'
modetype='mode_t'
more='more'
nm_so_opt=''
nonxs_ext='Errno'
nroff='nroff'
+nvsize='8'
+nvtype='double'
o_nonblock='O_NONBLOCK'
obj_ext='.o'
old_pthread_create_joinable=''
pr=''
prefix='/opt/perl'
prefixexp='/opt/perl'
-privlib='/opt/perl/lib/5.00561'
-privlibexp='/opt/perl/lib/5.00561'
+privlib='/opt/perl/lib/5.00563'
+privlibexp='/opt/perl/lib/5.00563'
prototype='define'
ptrsize='8'
+quadkind='2'
+quadtype='long'
randbits='48'
randfunc='drand48'
randseedtype='long'
sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 6 6 16 20 23 23 23 29 48 '
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0'
signal_t='void'
-sitearch='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread'
-sitearchexp='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread'
+sitearch='/opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread'
+sitearchexp='/opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread'
+sitebin='/opt/perl/bin'
+sitebinexp='/opt/perl/bin'
sitelib='/opt/perl/lib/site_perl'
sitelibexp='/opt/perl/lib/site_perl'
siteprefix='/opt/perl'
siteprefixexp='/opt/perl'
+sizesize='8'
sizetype='size_t'
sleep=''
smail=''
stdio_stream_array='_iob'
strings='/usr/include/string.h'
submit=''
-subversion='61'
+subversion='63'
sysman='/usr/man/man1'
tail=''
tar=''
tr='tr'
trnl='\n'
troff=''
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned int'
+u64size='8'
+u64type='unsigned long'
+u8size='1'
+u8type='unsigned char'
+uidformat='"u"'
uidsign='1'
+uidsize='4'
uidtype='uid_t'
uname='uname'
uniq='uniq'
+uquadtype='unsigned long'
use64bits='define'
usedl='define'
uselargefiles='undef'
uselongdouble='undef'
+uselonglong='undef'
usemorebits='undef'
usemultiplicity='undef'
usemymalloc='n'
usevfork='false'
usrinc='/usr/include'
uuname=''
+uvoformat='"lo"'
+uvsize='8'
+uvtype='unsigned long'
+uvuformat='"lu"'
+uvxformat='"lx"'
+vendorbin=''
+vendorbinexp=''
vendorlib=''
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.00561'
+version='5.00563'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='5.00561'
+xs_apiversion='5.00563'
zcat=''
zip='zip'
# Configure command line arguments.
config_arg11='-dE'
PERL_REVISION=5
PERL_VERSION=5
-PERL_SUBVERSION=61
-PERL_APIVERSION=5.00561
+PERL_SUBVERSION=63
+PERL_APIVERSION=5.00563
CONFIGDOTSH=true
# Variables propagated from previous config.sh file.
pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"'
/*
* Package name : perl5
* Source directory : .
- * Configuration time: Sun Oct 3 02:17:38 EET DST 1999
+ * Configuration time: Sat Nov 13 15:28:21 EET 1999
* Configured by : jhi
* Target system : osf1 alpha.hut.fi v4.0 878 alpha
*/
*/
#define HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-#define HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-#define HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define STDCHAR unsigned char /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t.
+ */
+/* Quad_t:
+ * This symbol holds the type used for 64-bit integers.
+ * It can be int, long, long long, int64_t etc...
+ */
+/* Uquad_t:
+ * This symbol holds the type used for unsigned 64-bit integers.
+ * It can be unsigned int, unsigned long, unsigned long long,
+ * uint64_t etc...
+ */
+#define HAS_QUAD /**/
+#define Quad_t long /**/
+#define Uquad_t unsigned long /**/
+#ifdef HAS_QUAD
+# define QUADKIND 2 /**/
+# define QUAD_IS_INT 1
+# define QUAD_IS_LONG 2
+# define QUAD_IS_LONG_LONG 3
+# define QUAD_IS_INT64_T 4
+#endif
+
/* HAS_ACCESSX:
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "/opt/perl/lib/5.00561/alpha-dec_osf-thread" /**/
-#define ARCHLIB_EXP "/opt/perl/lib/5.00561/alpha-dec_osf-thread" /**/
+#define ARCHLIB "/opt/perl/lib/5.00563/alpha-dec_osf-thread" /**/
+#define ARCHLIB_EXP "/opt/perl/lib/5.00563/alpha-dec_osf-thread" /**/
/* BIN:
* This symbol holds the path of the bin directory where the package will
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/opt/perl/lib/5.00561" /**/
-#define PRIVLIB_EXP "/opt/perl/lib/5.00561" /**/
+#define PRIVLIB "/opt/perl/lib/5.00563" /**/
+#define PRIVLIB_EXP "/opt/perl/lib/5.00563" /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-dependent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread" /**/
-#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread" /**/
+#define SITEARCH "/opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread" /**/
+#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-independent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
*/
#define HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-#define HAS_MMAP /**/
-#define Mmap_t void * /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#define HAS_SOCKET /**/
#define HAS_SOCKETPAIR /**/
#define HAS_MSG_CTRUNC /**/
#define HAS_MSG_PEEK /**/
/*#define HAS_MSG_PROXY / **/
#define HAS_SCM_RIGHTS /**/
-#define HAS_SENDMSG /**/
-#define HAS_RECVMSG /**/
-#define HAS_STRUCT_MSGHDR /**/
-#define HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
+#ifndef USE_STAT_BLOCKS
#define USE_STAT_BLOCKS /**/
+#endif
/* HAS_STRERROR:
* This symbol, if defined, indicates that the strerror routine is
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/* HAS_STRUCT_IOVEC:
- * This symbol, if defined, indicates that the struct iovec
- * to do scatter writes/gather reads is supported.
- */
#define I_SYSUIO /**/
-#define HAS_STRUCT_IOVEC /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
*/
/*#define HAS_ENDSPENT / **/
+/* HAS_STRUCT_FS_DATA:
+ * This symbol, if defined, indicates that the struct fs_data
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA / **/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FSEEKO / **/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat filesystems by file descriptors.
+ */
+#define HAS_FSTATFS /**/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FTELLO / **/
+/* HAS_GETMNT:
+ * This symbol, if defined, indicates that the getmnt routine is
+ * available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT / **/
+
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
- * available to iterate through mounted file systems.
+ * available to iterate through mounted file systems to get their info.
*/
/*#define HAS_GETMNTENT / **/
*/
/*#define HAS_HASMNTOPT / **/
+/* HAS_INT64_T:
+ * This symbol will defined if the C compiler supports int64_t.
+ * Usually the <inttypes.h> needs to be included, but sometimes
+ * <sys/types.h> is enough.
+ */
+/*#define HAS_INT64_T / **/
+
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* or <limits.h> defines the symbol LDBL_DIG, which is the number
*/
#define HAS_LDBL_DIG /* */
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-#define HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-#define HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-#define HAS_READV /**/
-
/* HAS_SETSPENT:
* This symbol, if defined, indicates that the setspent system call is
* available to initialize the scan of SysV shadow password entries.
*/
/*#define USE_SFIO / **/
-/* HAS_FSTATFS:
- * This symbol, if defined, indicates that the fstatfs routine is
- * available to stat filesystems of file descriptors.
+/* HAS_SQRTL:
+ * This symbol, if defined, indicates that the sqrtl routine is
+ * available to do long double square roots.
*/
-/* HAS_STRUCT_STATFS_FLAGS:
+#define HAS_SQRTL /**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* does have the f_flags member containing the mount flags of
- * the filesystem holding the file.
- * This kind of struct statfs is coming from sys/mount.h (BSD),
- * not from sys/statfs.h (SYSV).
+ * the filesystem containing the file.
+ * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not
+ * have statfs() and struct statfs, they have ustat() and getmnt()
+ * with struct ustat and struct fs_data.
*/
-#define HAS_FSTATFS /**/
-#define HAS_STRUCT_STATFS_FLAGS /**/
+#define HAS_STRUCT_STATFS_F_FLAGS /**/
+
+/* HAS_STRUCT_STATFS:
+ * This symbol, if defined, indicates that the struct statfs
+ * to do statfs() is supported.
+ */
+#define HAS_STRUCT_STATFS /**/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
- * available to stat filesystems of file descriptors.
+ * available to stat filesystems by file descriptors.
*/
#define HAS_FSTATVFS /**/
*/
#define HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
+/* HAS_USTAT:
+ * This symbol, if defined, indicates that the ustat system call is
+ * available to query file system statistics by dev_t.
*/
-#define HAS_WRITEV /**/
+#define HAS_USTAT /**/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/* HAS_INT64_T:
- * This symbol will defined if the C compiler supports int64_t.
- * Usually the <inttypes.h> needs to be included, but sometimes
- * <sys/types.h> is enough.
- */
/*#define I_INTTYPES / **/
-/*#define HAS_INT64_T / **/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
*/
/*#define I_SOCKS / **/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-#define I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
#define I_SYS_MOUNT /**/
+/* I_SYS_STATFS:
+ * This symbol, if defined, indicates that <sys/statfs.h> exists.
+ */
+/*#define I_SYS_STATFS / **/
+
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
#define I_SYS_STATVFS /**/
+/* I_SYS_VFS:
+ * This symbol, if defined, indicates that <sys/vfs.h> exists and
+ * should be included.
+ */
+/*#define I_SYS_VFS / **/
+
+/* I_USTAT:
+ * This symbol, if defined, indicates that <ustat.h> exists and
+ * should be included.
+ */
+#define I_USTAT /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
#define PERL_PRIfldbl "f" /**/
#define PERL_PRIgldbl "g" /**/
-/* PERL_PRId64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit decimal numbers (format 'd') for output.
+/* IVTYPE:
+ * This symbol defines the C type used for Perl's IV.
*/
-/* PERL_PRIu64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit unsigned decimal numbers (format 'u') for output.
+/* UVTYPE:
+ * This symbol defines the C type used for Perl's UV.
*/
-/* PERL_PRIo64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit octal numbers (format 'o') for output.
+/* I8TYPE:
+ * This symbol defines the C type used for Perl's I8.
*/
-/* PERL_PRIx64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit hexadecimal numbers (format 'x') for output.
+/* U8TYPE:
+ * This symbol defines the C type used for Perl's U8.
+ */
+/* I16TYPE:
+ * This symbol defines the C type used for Perl's I16.
+ */
+/* U16TYPE:
+ * This symbol defines the C type used for Perl's U16.
+ */
+/* I32TYPE:
+ * This symbol defines the C type used for Perl's I32.
+ */
+/* U32TYPE:
+ * This symbol defines the C type used for Perl's U32.
+ */
+/* I64TYPE:
+ * This symbol defines the C type used for Perl's I64.
+ */
+/* U64TYPE:
+ * This symbol defines the C type used for Perl's U64.
+ */
+/* NVTYPE:
+ * This symbol defines the C type used for Perl's NV.
+ */
+/* IVSIZE:
+ * This symbol contains the sizeof(IV).
+ */
+/* UVSIZE:
+ * This symbol contains the sizeof(UV).
+ */
+/* I8SIZE:
+ * This symbol contains the sizeof(I8).
+ */
+/* U8SIZE:
+ * This symbol contains the sizeof(U8).
+ */
+/* I16SIZE:
+ * This symbol contains the sizeof(I16).
+ */
+/* U16SIZE:
+ * This symbol contains the sizeof(U16).
+ */
+/* I32SIZE:
+ * This symbol contains the sizeof(I32).
+ */
+/* U32SIZE:
+ * This symbol contains the sizeof(U32).
+ */
+/* I64SIZE:
+ * This symbol contains the sizeof(I64).
+ */
+/* U64SIZE:
+ * This symbol contains the sizeof(U64).
+ */
+/* NVSIZE:
+ * This symbol contains the sizeof(NV).
+ */
+#define IVTYPE long /**/
+#define UVTYPE unsigned long /**/
+#define I8TYPE char /**/
+#define U8TYPE unsigned char /**/
+#define I16TYPE short /**/
+#define U16TYPE unsigned short /**/
+#define I32TYPE int /**/
+#define U32TYPE unsigned int /**/
+#ifdef HAS_QUAD
+#define I64TYPE long /**/
+#define U64TYPE unsigned long /**/
+#endif
+#define NVTYPE double /**/
+#define IVSIZE 8 /**/
+#define UVSIZE 8 /**/
+#define I8SIZE 1 /**/
+#define U8SIZE 1 /**/
+#define I16SIZE 2 /**/
+#define U16SIZE 2 /**/
+#define I32SIZE 4 /**/
+#define U32SIZE 4 /**/
+#ifdef HAS_QUAD
+#define I64SIZE 8 /**/
+#define U64SIZE 8 /**/
+#endif
+#define NVSIZE 8 /**/
+
+/* IVdf:
+ * This symbol defines the format string used for printing a Perl IV
+ * as a signed decimal integer.
+ */
+/* UVuf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned decimal integer.
+ */
+/* UVof:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned octal integer.
*/
-#define PERL_PRId64 "ld" /**/
-#define PERL_PRIu64 "lu" /**/
-#define PERL_PRIo64 "lo" /**/
-#define PERL_PRIx64 "lx" /**/
+/* UVxf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned hexadecimal integer.
+ */
+#define IVdf "ld" /**/
+#define UVuf "lu" /**/
+#define UVof "lo" /**/
+#define UVxf "lx" /**/
/* SELECT_MIN_BITS:
* This symbol holds the minimum number of bits operated by select.
* be used when available. If not defined, the native default interfaces
* will be used (be they 32 or 64 bits).
*/
+#ifndef USE_64_BITS
#define USE_64_BITS /**/
+#endif
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available. The USE_64_BITS symbol will
* also be turned on if necessary.
*/
+#ifndef USE_LARGE_FILES
/*#define USE_LARGE_FILES / **/
+#endif
/* USE_LONG_DOUBLE:
* This symbol, if defined, indicates that long doubles should
* be used when available.
*/
+#ifndef USE_LONG_DOUBLE
/*#define USE_LONG_DOUBLE / **/
+#endif
+
+/* USE_LONG_LONG:
+ * This symbol, if defined, indicates that long longs should
+ * be used when available.
+ */
+#ifndef USE_LONG_LONG
+/*#define USE_LONG_LONG / **/
+#endif
+
+#ifndef USE_MORE_BITS
+/*#define USE_MORE_BITS / **/
+#endif
/* MULTIPLICITY:
* This symbol, if defined, indicates that Perl should
* be built to use multiplicity.
*/
+#ifndef MULTIPLICTY
/*#define MULTIPLICITY / **/
+#endif
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
* used in a fully backward compatible manner.
*/
+#ifndef USE_PERLIO
/*#define USE_PERLIO / **/
+#endif
/* USE_SOCKS:
* This symbol, if defined, indicates that Perl should
* be built to use socks.
*/
+#ifndef USE_SOCKS
/*#define USE_SOCKS / **/
+#endif
/* PERL_XS_APIVERSION:
* This variable contains the version of the oldest perl binary
* compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread for older
+ * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.00563/alpha-dec_osf-thread for older
* directories across major versions back to xs_apiversion.
* This is only useful if you have a perl library directory tree
* structured like the default one.
* (presumably) be similar.
* See the INSTALL file for how this works.
*/
-#define PERL_XS_APIVERSION 5.00561 /* Change to string for tuples?*/
+#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
+#ifndef USE_TTHREADS
#define USE_THREADS /**/
+#endif
/*#define OLD_PTHREADS_API / **/
/* Time_t:
*/
#define Fpos_t fpos_t /* File position type */
+/* Gid_t_f:
+ * This symbol defines the format string used for printing a Gid_t.
+ */
+#define Gid_t_f "u" /**/
+
+/* Gid_t_size:
+ * This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4 /* GID size */
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
/* LSEEKSIZE:
* This symbol holds the number of bytes used by the Off_t.
*/
+/* Off_t_size:
+ * This symbol holds the number of bytes used by the Off_t.
+ */
#define Off_t off_t /* <offset> type */
#define LSEEKSIZE 8 /* <offset> size */
+#define Off_t_size 8 /* <offset> size */
/* Mode_t:
* This symbol holds the type used to declare file modes
*/
#define Pid_t pid_t /* PID type */
+/* Size_t_size:
+ * This symbol holds the size of a Size_t in bytes.
+ */
+#define Size_t_size 8 /* */
+
/* Size_t:
* This symbol holds the type used to declare length parameters
* for string functions. It is usually size_t, but may be
*/
#define Size_t size_t /* length paramater for string functions */
-/* Uid_t_SIGN:
- * This symbol holds the signedess of a Uid_t.
- * 1 for unsigned, -1 for signed.
+/* Uid_t_f:
+ * This symbol defines the format string used for printing a Uid_t.
+ */
+#define Uid_t_f "u" /**/
+
+/* Uid_t_size:
+ * This symbol holds the size of a Uid_t in bytes.
*/
-#define Uid_t_SIGN 1 /* UID sign */
+#define Uid_t_size 4 /* UID size */
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
#
# Outputs the changelist to stdout.
#
-# Gurusamy Sarathy <gsar@umich.edu>
+# Gurusamy Sarathy <gsar@activestate.com>
#
use Text::Wrap;
# reads a perforce style diff on stdin and outputs appropriate headers
# so the diff can be applied with the patch program
#
-# Gurusamy Sarathy <gsar@umich.edu>
+# Gurusamy Sarathy <gsar@activestate.com>
#
BEGIN {
#
# Munge "p4 describe ..." output to include new files.
#
-# Gurusamy Sarathy <gsar@umich.edu>
+# Gurusamy Sarathy <gsar@activestate.com>
#
use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles);
use strict;
use vars qw($VERSION);
-$VERSION = 2.10;
+$VERSION = 2.11;
sub usage {
die qq{
(F has \$ appended unless it contains a /).
-e Expect patched files to Exist (relative to current directory)
Will print warnings for files which don't. Also affects -4 option.
+ - Read patch from STDIN
other options for special uses:
-I just gather and display summary Information about the patches.
-4 write to stdout the PerForce commands to prepare for patching.
warn "Ignored directory $in\n";
next;
}
- unless (open F, "<$in") {
+ if ($in eq "-") {
+ *F = \*STDIN;
+ } elsif (not open F, "<$in") {
warn "Unable to open $in: $!\n";
next;
}
==================================================
Olaf Flebbe <o.flebbe@gmx.de>
-http://www.fortunecity.de/wolkenkratzer/trumpet/84/perl5.html
-Aug 25, 1999
+http://www.linuxstart.com/~oflebbe/perl/perl.html
+1999-11-01
Introduction
------------
-This is a port of Perl version 5.005_60 to EPOC.
+This is a port of Perl version 5.005_62 to EPOC.
There are many features left out, because of restrictions of the POSIX
support in the SDK.
Notes on Perl on the Hurd
-Last Updated: Sat, 6 Mar 1999 16:07:59 +0100
+Last Updated: Fri, 29 Oct 1999 22:50:30 +0200
Written by: Mark Kettenis <kettenis@gnu.org>
If you want to use Perl on the Hurd, I recommend using the Debian
* Known Problems
-The Perl testsuite may still report some errors on the Hurd. The
-`lib/anydbm.t' and `op/stat.t' tests will most certainly fail. The
-first fails because Berkeley DB 2 does not allow empty keys and the
-test tries to use them anyway. This is not really a Hurd bug. The
-same test fails on Linux with version 2.1 of the GNU C Library. The
-second failure is caused by a bug in the Hurd's filesystem servers,
-that we have not been able to fix yet. I don't think it is crucial.
+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_03 on my system:
+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
-op/stat.t 58 1 1.72% 4
-5 tests skipped, plus 14 subtests skipped.
-Failed 2/189 test scripts, 98.94% okay. 2/6669 subtests failed, 99.97% okay.
+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 testsuite have been fixed, you may
-encounter more failures. Likely candidates are: `lib/io_pipe.t',
-`lib/io_sock.t', `lib/io_udp.t' and `lib/time.t'.
+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.
-Last Revised 01-March-1999 by Dan Sugalski <sugalskd@ous.edu>
+Last revised 27-October-1999 by Craig Berry <craig.berry@metamor.com>
+Revised 01-March-1999 by Dan Sugalski <dan@sidhe.org>
Originally by Charles Bailey <bailey@newman.upenn.edu>
* Important safety tip
If one or more tests fail, you can get more info on the failure by issuing
this command sequence:
-$ @[.VMS]TEST .typ "-v" [.subdir]test.T
+$ @[.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 [.op]time failed, then you'd do this:
-$ @[.VMS]TEST .EXE "-v" [.OP]TIME.T
+$ @[.VMS]TEST .EXE "" "-v" [.OP]TIME.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:
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 1500 blocks
+a known image. PERLSHR.EXE is typically larger than 2000 blocks
and that is a reasonably large amount of IO to load each time perl is
invoked.
* Dec C issues
Note to DECC users: Some early versions (pre-5.2, some pre-4. If you're Dec
-C 5.x or higher, with current patches if anym you're fine) of the DECCRTL
+C 5.x or higher, with current patches if any, you're fine) of the DECCRTL
contained a few bugs which affect Perl performance:
- 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
there is the VMSPERL mailing list. It's usually a low-volume (10-12
messages a week) mailing list.
-The subscription address is VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Send a mail
-message with just the words SUBSCRIBE VMSPERL in the body of the message.
-
-The VMSPERL mailing list address is VMSPERL@NEWMAN.UPENN.EDU. Any mail
-sent there gets echoed to all subscribers of the list.
-
+The subscription address is MAJORDOMO@PERL.ORG. Send a mail message with just
+the words SUBSCRIBE VMSPERL in the body of the message.
+
+The VMSPERL mailing list address is VMSPERL@PERL.ORG. Any mail sent there
+gets echoed to all subscribers of the list. There is a searchable archive of
+the list at <http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/>.
+
To unsubscribe from VMSPERL send the message UNSUBSCRIBE VMSPERL to
-VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Be sure to do so from the subscribed
-account that you are cancelling.
-
+MAJORDOMO@PERL.ORG. Be sure to do so from the subscribed account that
+you are cancelling.
* Acknowledgements
Peter Prymmer <pvhp@forte.com> or <pvhp@lns62.lns.cornell.edu>
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
- Dan Sugalski <sugalskd@ous.edu>
+ Dan Sugalski <dan@sidhe.org>
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
Gary Ng E<lt>71564.1743@CompuServe.COME<gt>
-Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>
+Gurusamy Sarathy E<lt>gsar@activestate.comE<gt>
Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt>
# 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 setjmp PerlProc_setjmp
# define longjmp PerlProc_longjmp
# define signal PerlProc_signal
+# define getpid PerlProc_getpid
# define htonl PerlSock_htonl
# define htons PerlSock_htons
# define ntohl PerlSock_ntohl
struct xpvav {
char* xav_array; /* pointer to first array element */
SSize_t xav_fill; /* Index of last element present */
- SSize_t xav_max; /* Number of elements for which array has space */
+ 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 */
U8 => [qw(char)],
);
-my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
+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).
xcv_start CvSTART(bytecode_sv) opindex
xcv_root CvROOT(bytecode_sv) opindex
xcv_gv *(SV**)&CvGV(bytecode_sv) svindex
-xcv_filegv *(SV**)&CvFILEGV(bytecode_sv) svindex
+xcv_file CvFILE(bytecode_sv) pvcontents
xcv_depth CvDEPTH(bytecode_sv) long
xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex
xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex
gp_av *(SV**)&GvAV(bytecode_sv) svindex
gp_hv *(SV**)&GvHV(bytecode_sv) svindex
gp_cv *(SV**)&GvCV(bytecode_sv) svindex
-gp_filegv *(SV**)&GvFILEGV(bytecode_sv) svindex
+gp_file GvFILE(bytecode_sv) pvcontents
gp_io *(SV**)&GvIOp(bytecode_sv) svindex
gp_form *(SV**)&GvFORM(bytecode_sv) svindex
gp_cvgen GvCVGEN(bytecode_sv) U32
op_pmflags cPMOP->op_pmflags U16
op_pmpermflags cPMOP->op_pmpermflags U16
op_sv cSVOP->op_sv svindex
-op_gv *(SV**)&cGVOP->op_gv 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 pvcontents
-cop_stash *(SV**)&cCOP->cop_stash svindex
-cop_filegv *(SV**)&cCOP->cop_filegv svindex
+cop_stashpv cCOP pvcontents x
+cop_file cCOP pvcontents x
cop_seq cCOP->cop_seq U32
cop_arybase cCOP->cop_arybase I32
-cop_line cCOP->cop_line line_t
+cop_line cCOP line_t x
cop_warnings cCOP->cop_warnings svindex
main_start PL_main_start opindex
main_root PL_main_root opindex
*/
#$d_mktime HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-#$d_msync HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-#$d_munmap HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define STDCHAR $stdchar /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
+ */
+#$d_quad HAS_QUAD /**/
+#ifdef HAS_QUAD
+# define Quad_t $quadtype /**/
+# define Uquad_t $uquadtype /**/
+# define QUADKIND $quadkind /**/
+# define QUAD_IS_INT 1
+# define QUAD_IS_LONG 2
+# define QUAD_IS_LONG_LONG 3
+# define QUAD_IS_INT64_T 4
+#endif
+
/* HAS_ACCESSX:
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-dependent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-independent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
*/
#$d_memchr HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-#$d_mmap HAS_MMAP /**/
-#define Mmap_t $mmaptype /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#$d_socket HAS_SOCKET /**/
#$d_sockpair HAS_SOCKETPAIR /**/
#$d_msg_ctrunc HAS_MSG_CTRUNC /**/
#$d_msg_peek HAS_MSG_PEEK /**/
#$d_msg_proxy HAS_MSG_PROXY /**/
#$d_scm_rights HAS_SCM_RIGHTS /**/
-#$d_sendmsg HAS_SENDMSG /**/
-#$d_recvmsg HAS_RECVMSG /**/
-#$d_msghdr_s HAS_STRUCT_MSGHDR /**/
-#$d_cmsghdr_s HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
+#ifndef USE_STAT_BLOCKS
#$d_statblks USE_STAT_BLOCKS /**/
+#endif
/* HAS_STRERROR:
* This symbol, if defined, indicates that the strerror routine is
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/* HAS_STRUCT_IOVEC:
- * This symbol, if defined, indicates that the struct iovec
- * to do scatter writes/gather reads is supported.
- */
#$i_sysuio I_SYSUIO /**/
-#$d_iovec_s HAS_STRUCT_IOVEC /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
*/
#$d_endspent HAS_ENDSPENT /**/
+/* HAS_STRUCT_FS_DATA:
+ * This symbol, if defined, indicates that the struct fs_data
+ * to do statfs() is supported.
+ */
+#$d_fs_data_s HAS_STRUCT_FS_DATA /**/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
#$d_fseeko HAS_FSEEKO /**/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat filesystems by file descriptors.
+ */
+#$d_fstatfs HAS_FSTATFS /**/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
#$d_ftello HAS_FTELLO /**/
+/* HAS_GETMNT:
+ * This symbol, if defined, indicates that the getmnt routine is
+ * available to get filesystem mount info by filename.
+ */
+#$d_getmnt HAS_GETMNT /**/
+
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
- * available to iterate through mounted file systems.
+ * available to iterate through mounted file systems to get their info.
*/
#$d_getmntent HAS_GETMNTENT /**/
*/
#$d_hasmntopt HAS_HASMNTOPT /**/
+/* HAS_INT64_T:
+ * This symbol will defined if the C compiler supports int64_t.
+ * Usually the <inttypes.h> needs to be included, but sometimes
+ * <sys/types.h> is enough.
+ */
+#$d_int64t HAS_INT64_T /**/
+
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* or <limits.h> defines the symbol LDBL_DIG, which is the number
*/
#$d_ldbl_dig HAS_LDBL_DIG /* */
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-#$d_madvise HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-#$d_mprotect HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-#$d_readv HAS_READV /**/
-
/* HAS_SETSPENT:
* This symbol, if defined, indicates that the setspent system call is
* available to initialize the scan of SysV shadow password entries.
*/
#$d_sfio USE_SFIO /**/
-/* HAS_FSTATFS:
- * This symbol, if defined, indicates that the fstatfs routine is
- * available to stat filesystems of file descriptors.
+/* HAS_SQRTL:
+ * This symbol, if defined, indicates that the sqrtl routine is
+ * available to do long double square roots.
*/
-/* HAS_STRUCT_STATFS_FLAGS:
+#$d_sqrtl HAS_SQRTL /**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* does have the f_flags member containing the mount flags of
- * the filesystem holding the file.
- * This kind of struct statfs is coming from sys/mount.h (BSD),
- * not from sys/statfs.h (SYSV).
+ * the filesystem containing the file.
+ * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not
+ * have statfs() and struct statfs, they have ustat() and getmnt()
+ * with struct ustat and struct fs_data.
*/
-#$d_fstatfs HAS_FSTATFS /**/
-#$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/
+#$d_statfs_f_flags HAS_STRUCT_STATFS_F_FLAGS /**/
+
+/* HAS_STRUCT_STATFS:
+ * This symbol, if defined, indicates that the struct statfs
+ * to do statfs() is supported.
+ */
+#$d_statfs_s HAS_STRUCT_STATFS /**/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
- * available to stat filesystems of file descriptors.
+ * available to stat filesystems by file descriptors.
*/
#$d_fstatvfs HAS_FSTATVFS /**/
*/
#$d_telldirproto HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
+/* HAS_USTAT:
+ * This symbol, if defined, indicates that the ustat system call is
+ * available to query file system statistics by dev_t.
*/
-#$d_writev HAS_WRITEV /**/
+#$d_ustat HAS_USTAT /**/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/* HAS_INT64_T:
- * This symbol will defined if the C compiler supports int64_t.
- * Usually the <inttypes.h> needs to be included, but sometimes
- * <sys/types.h> is enough.
- */
#$i_inttypes I_INTTYPES /**/
-#$d_int64t HAS_INT64_T /**/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
*/
#$i_socks I_SOCKS /**/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-#$i_sysmman I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
#$i_sysmount I_SYS_MOUNT /**/
+/* I_SYS_STATFS:
+ * This symbol, if defined, indicates that <sys/statfs.h> exists.
+ */
+#$i_sysstatfs I_SYS_STATFS /**/
+
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
#$i_sysstatvfs I_SYS_STATVFS /**/
+/* I_SYS_VFS:
+ * This symbol, if defined, indicates that <sys/vfs.h> exists and
+ * should be included.
+ */
+#$i_sysvfs I_SYS_VFS /**/
+
+/* I_USTAT:
+ * This symbol, if defined, indicates that <ustat.h> exists and
+ * should be included.
+ */
+#$i_ustat I_USTAT /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
#$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/
#$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/
-/* PERL_PRId64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit decimal numbers (format 'd') for output.
+/* IVTYPE:
+ * This symbol defines the C type used for Perl's IV.
*/
-/* PERL_PRIu64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit unsigned decimal numbers (format 'u') for output.
+/* UVTYPE:
+ * This symbol defines the C type used for Perl's UV.
*/
-/* PERL_PRIo64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit octal numbers (format 'o') for output.
+/* I8TYPE:
+ * This symbol defines the C type used for Perl's I8.
*/
-/* PERL_PRIx64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit hexadecimal numbers (format 'x') for output.
+/* U8TYPE:
+ * This symbol defines the C type used for Perl's U8.
+ */
+/* I16TYPE:
+ * This symbol defines the C type used for Perl's I16.
+ */
+/* U16TYPE:
+ * This symbol defines the C type used for Perl's U16.
+ */
+/* I32TYPE:
+ * This symbol defines the C type used for Perl's I32.
+ */
+/* U32TYPE:
+ * This symbol defines the C type used for Perl's U32.
+ */
+/* I64TYPE:
+ * This symbol defines the C type used for Perl's I64.
+ */
+/* U64TYPE:
+ * This symbol defines the C type used for Perl's U64.
+ */
+/* NVTYPE:
+ * This symbol defines the C type used for Perl's NV.
+ */
+/* IVSIZE:
+ * This symbol contains the sizeof(IV).
+ */
+/* UVSIZE:
+ * This symbol contains the sizeof(UV).
+ */
+/* I8SIZE:
+ * This symbol contains the sizeof(I8).
+ */
+/* U8SIZE:
+ * This symbol contains the sizeof(U8).
+ */
+/* I16SIZE:
+ * This symbol contains the sizeof(I16).
+ */
+/* U16SIZE:
+ * This symbol contains the sizeof(U16).
+ */
+/* I32SIZE:
+ * This symbol contains the sizeof(I32).
+ */
+/* U32SIZE:
+ * This symbol contains the sizeof(U32).
+ */
+/* I64SIZE:
+ * This symbol contains the sizeof(I64).
+ */
+/* U64SIZE:
+ * This symbol contains the sizeof(U64).
+ */
+#define IVTYPE $ivtype /**/
+#define UVTYPE $uvtype /**/
+#define I8TYPE $i8type /**/
+#define U8TYPE $u8type /**/
+#define I16TYPE $i16type /**/
+#define U16TYPE $u16type /**/
+#define I32TYPE $i32type /**/
+#define U32TYPE $u32type /**/
+#ifdef HAS_QUAD
+#define I64TYPE $i64type /**/
+#define U64TYPE $u64type /**/
+#endif
+#define NVTYPE $nvtype /**/
+#define IVSIZE $ivsize /**/
+#define UVSIZE $uvsize /**/
+#define I8SIZE $i8size /**/
+#define U8SIZE $u8size /**/
+#define I16SIZE $i16size /**/
+#define U16SIZE $u16size /**/
+#define I32SIZE $i32size /**/
+#define U32SIZE $u32size /**/
+#ifdef HAS_QUAD
+#define I64SIZE $i64size /**/
+#define U64SIZE $u64size /**/
+#endif
+
+/* IVdf:
+ * This symbol defines the format string used for printing a Perl IV
+ * as a signed decimal integer.
+ */
+/* UVuf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned decimal integer.
*/
-#$d_PRId64 PERL_PRId64 $sPRId64 /**/
-#$d_PRIu64 PERL_PRIu64 $sPRIu64 /**/
-#$d_PRIo64 PERL_PRIo64 $sPRIo64 /**/
-#$d_PRIx64 PERL_PRIx64 $sPRIx64 /**/
+/* UVof:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned octal integer.
+ */
+/* UVxf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned hexadecimal integer.
+ */
+#define IVdf $ivdformat /**/
+#define UVuf $uvuformat /**/
+#define UVof $uvoformat /**/
+#define UVxf $uvxformat /**/
/* SELECT_MIN_BITS:
* This symbol holds the minimum number of bits operated by select.
#$d_strtoull HAS_STRTOULL /**/
/* USE_64_BITS:
- * This symbol, if defined, indicates that 64-bit interfaces should
- * be used when available. If not defined, the native default interfaces
+ * This symbol, if defined, indicates that 64-bit integers should
+ * be used when available. If not defined, the native integers
* will be used (be they 32 or 64 bits).
*/
+#ifndef USE_64_BITS
#$use64bits USE_64_BITS /**/
+#endif
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available. The USE_64_BITS symbol will
* also be turned on if necessary.
*/
+#ifndef USE_LARGE_FILES
#$uselargefiles USE_LARGE_FILES /**/
+#endif
/* USE_LONG_DOUBLE:
* This symbol, if defined, indicates that long doubles should
* be used when available.
*/
+#ifndef USE_LONG_DOUBLE
#$uselongdouble USE_LONG_DOUBLE /**/
+#endif
+
+/* USE_LONG_LONG:
+ * This symbol, if defined, indicates that long longs should
+ * be used when available.
+ */
+#ifndef USE_LONG_LONG
+#$uselonglong USE_LONG_LONG /**/
+#endif
+
+#ifndef USE_MORE_BITS
+#$usemorebits USE_MORE_BITS /**/
+#endif
/* MULTIPLICITY:
* This symbol, if defined, indicates that Perl should
* be built to use multiplicity.
*/
+#ifndef MULTIPLICTY
#$usemultiplicity MULTIPLICITY /**/
+#endif
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
* used in a fully backward compatible manner.
*/
+#ifndef USE_PERLIO
#$useperlio USE_PERLIO /**/
+#endif
/* USE_SOCKS:
* This symbol, if defined, indicates that Perl should
* be built to use socks.
*/
+#ifndef USE_SOCKS
#$usesocks USE_SOCKS /**/
+#endif
/* PERL_XS_APIVERSION:
* This variable contains the version of the oldest perl binary
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
+#ifndef USE_TTHREADS
#$usethreads USE_THREADS /**/
+#endif
#$d_oldpthreads OLD_PTHREADS_API /**/
/* Time_t:
*/
#define Fpos_t $fpostype /* File position type */
+/* Gid_t_f:
+ * This symbol defines the format string used for printing a Gid_t.
+ */
+#define Gid_t_f $gidformat /**/
+
+/* Gid_t_size:
+ * This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size $gidsize /* GID size */
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
/* LSEEKSIZE:
* This symbol holds the number of bytes used by the Off_t.
*/
+/* Off_t_size:
+ * This symbol holds the number of bytes used by the Off_t.
+ */
#define Off_t $lseektype /* <offset> type */
#define LSEEKSIZE $lseeksize /* <offset> size */
+#define Off_t_size $lseeksize /* <offset> size */
/* Mode_t:
* This symbol holds the type used to declare file modes
*/
#define Size_t $sizetype /* length paramater for string functions */
-/* Uid_t_SIGN:
- * This symbol holds the signedess of a Uid_t.
- * 1 for unsigned, -1 for signed.
+/* Uid_t_f:
+ * This symbol defines the format string used for printing a Uid_t.
+ */
+#define Uid_t_f $uidformat /**/
+
+/* Uid_t_size:
+ * This symbol holds the size of a Uid_t in bytes.
*/
-#define Uid_t_SIGN $uidsign /* UID sign */
+#define Uid_t_size $uidsize /* UID size */
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
$! Ask if they want to build with 64-bit support
$ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1")
$ THEN
-$ echo "This version of perl has experimental support for building wtih
+$ echo "This version of perl has experimental support for building with
$ echo "64 bit integers and 128 bit floating point variables. This gives
$ echo "a much larger range for perl's mathematical operations. (Note that
$ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't
$ ENDIF
$ ENDIF
$!
-$! Ask if they want to build with 64-bit support
-$ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1")
-$ THEN
-$ echo "This version of perl has experimental support for building wtih
-$ echo "64 bit integers and 128 bit floating point variables. This gives
-$ echo "a much larger range for perl's mathematical operations. (Note that
-$ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't
-$ echo "do that yet)"
-$ echo ""
-$ dflt = use_64bit
-$ rp = "Build with 64 bits? [''dflt'] "
-$ GOSUB myread
-$ if ans.eqs."" then ans = dflt
-$ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y")
-$ THEN
-$ use_64bit="Y"
-$ ELSE
-$ use_64bit="N"
-$ ENDIF
-$ ENDIF
$! Ask about threads, if appropriate
$ if (Using_Dec_C.eqs."Yes")
$ THEN
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 */
#define Nullcop Null(COP*)
+#ifdef USE_ITHREADS
+# define CopFILE(c) ((c)->cop_file)
+# define CopFILEGV(c) (CopFILE(c) \
+ ? gv_fetchfile(CopFILE(c)) : Nullgv)
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */
+# 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)
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */
+# define CopSTASH(c) (CopSTASHPV(c) \
+ ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv))
+# define CopSTASH_eq(c,hv) (hv \
+ && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#else
+# define CopFILEGV(c) ((c)->cop_filegv)
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv)
+# define CopFILE_set(c,pv) ((c)->cop_filegv = 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(CopSTASH(c)) : Nullch)
+# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD))
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv)
+#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))
+
/*
* Here we have some enormously heavy (or at least ponderous) wizardry.
*/
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
#ifdef USE_THREADS
-#define POPSAVEARRAY() NOOP
+# define POP_SAVEARRAY() NOOP
#else
-#define POPSAVEARRAY() \
+# define POP_SAVEARRAY() \
STMT_START { \
SvREFCNT_dec(GvAV(PL_defgv)); \
GvAV(PL_defgv) = cx->blk_sub.savearray; \
} STMT_END
#endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+ /* junk in @_ spells trouble when cloning CVs, so don't leave any */
+# define CLEAR_ARGARRAY() av_clear(cx->blk_sub.argarray)
+#else
+# define CLEAR_ARGARRAY() NOOP
+#endif /* USE_ITHREADS */
+
+
#define POPSUB(cx,sv) \
STMT_START { \
if (cx->blk_sub.hasargs) { \
- POPSAVEARRAY(); \
+ POP_SAVEARRAY(); \
/* abandon @_ if it got reified */ \
if (AvREAL(cx->blk_sub.argarray)) { \
SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \
PL_curpad[0] = (SV*)cx->blk_sub.argarray; \
} \
+ else { \
+ CLEAR_ARGARRAY(); \
+ } \
} \
sv = (SV*)cx->blk_sub.cv; \
if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \
#define PUSHEVAL(cx,n,fgv) \
cx->blk_eval.old_in_eval = PL_in_eval; \
cx->blk_eval.old_op_type = PL_op->op_type; \
- cx->blk_eval.old_name = n; \
+ cx->blk_eval.old_name = (n ? savepv(n) : Nullch); \
cx->blk_eval.old_eval_root = PL_eval_root; \
cx->blk_eval.cur_text = PL_linestr;
#define POPEVAL(cx) \
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;
+ PL_eval_root = cx->blk_eval.old_eval_root; \
+ Safefree(cx->blk_eval.old_name);
/* loop context */
struct block_loop {
OP * redo_op;
OP * next_op;
OP * last_op;
+#ifdef USE_ITHREADS
+ void * iterdata;
+#else
SV ** itervar;
+#endif
SV * itersave;
SV * iterlval;
AV * iterary;
IV itermax;
};
-#define PUSHLOOP(cx, ivar, s) \
+#ifdef USE_ITHREADS
+# define CxITERVAR(c) \
+ ((c)->blk_loop.iterdata \
+ ? (CxPADLOOP(cx) \
+ ? &PL_curpad[(PADOFFSET)(c)->blk_loop.iterdata] \
+ : &GvSV((GV*)(c)->blk_loop.iterdata)) \
+ : (SV**)NULL)
+# define CX_ITERDATA_SET(cx,idata) \
+ if (cx->blk_loop.iterdata = (idata)) \
+ cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));
+#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));
+#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; \
- if (cx->blk_loop.itervar = (ivar)) \
- cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
cx->blk_loop.iterlval = Nullsv; \
cx->blk_loop.iterary = Nullav; \
- cx->blk_loop.iterix = -1;
+ cx->blk_loop.iterix = -1; \
+ CX_ITERDATA_SET(cx,dat);
#define POPLOOP(cx) \
SvREFCNT_dec(cx->blk_loop.iterlval); \
- if (cx->blk_loop.itervar) { \
- sv_2mortal(*(cx->blk_loop.itervar)); \
- *(cx->blk_loop.itervar) = cx->blk_loop.itersave; \
+ 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);
#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 */
+#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 CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \
+ == (CXt_EVAL|CXp_REAL))
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
I32 si_type; /* type of runlevel */
struct stackinfo * si_prev;
struct stackinfo * si_next;
- I32 * si_markbase; /* where markstack begins for us.
+ I32 si_markoff; /* offset where markstack begins for us.
* currently used only with DEBUGGING,
* but not #ifdef-ed for bincompat */
};
#define cxstack_max (PL_curstackinfo->si_cxmax)
#ifdef DEBUGGING
-# define SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
+# define SET_MARK_OFFSET \
+ PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
#else
-# define SET_MARKBASE NOOP
+# define SET_MARK_OFFSET NOOP
#endif
#define PUSHSTACKi(type) \
AvFILLp(next->si_stack) = 0; \
SWITCHSTACK(PL_curstack,next->si_stack); \
PL_curstackinfo = next; \
- SET_MARKBASE; \
+ SET_MARK_OFFSET; \
} STMT_END
#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
*
*/
-/* This structure much match the beginning of XPVFM */
+/* This structure much match XPVCV in B/C.pm and the beginning of XPVFM
+ * in sv.h */
struct xpvcv {
char * xpv_pv; /* pointer to malloced string */
void (*xcv_xsub) (pTHXo_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
- GV * xcv_filegv;
- long xcv_depth; /* >= 2 indicates recursive call */
+ char * xcv_file;
+ long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
#ifdef USE_THREADS
#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 CvFILEGV(sv) ((XPVCV*)SvANY(sv))->xcv_filegv
+#define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file
+#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 DEBUGGING
dTHR;
register I32 i;
- GV* gv = PL_curcop->cop_filegv;
+ char* file = CopFILE(PL_curcop);
#ifdef USE_THREADS
- PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
- (unsigned long) thr,
- SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
- (long)PL_curcop->cop_line);
+ 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",
- SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
- (long)PL_curcop->cop_line);
+ PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
+ (long)CopLINE(PL_curcop));
#endif /* USE_THREADS */
- for (i=0; i<PL_dlevel; i++)
- PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
(void) PerlIO_vprintf(Perl_debug_log, pat, *args);
#endif /* DEBUGGING */
}
-void
-Perl_deb_growlevel(pTHX)
-{
-#ifdef DEBUGGING
- PL_dlmax += 128;
- Renew(PL_debname, PL_dlmax, char);
- Renew(PL_debdelim, PL_dlmax, char);
-#endif /* DEBUGGING */
-}
-
I32
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
dTHR;
- PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
- (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
- (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
- (long)(PL_stack_max-PL_stack_base));
- PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
- (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
- (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
+ 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;
}
dTHR;
I32 top = PL_stack_sp - PL_stack_base;
register I32 i = top - 30;
- I32 *markscan = PL_curstackinfo->si_markbase;
+ I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
if (i < 0)
i = 0;
break;
#ifdef USE_THREADS
- PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
- (unsigned long) thr);
+ PerlIO_printf(Perl_debug_log,
+ i ? "0x%"UVxf" => ... " : "0x%lx => ",
+ PTR2UV(thr));
#else
PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
#endif /* USE_THREADS */
-e 's/thread/Thread/'\
-e 's/byteload/ByteLoader/'\
-e 's=devel/peek=Devel/Peek='\
- -e 's=devel/dprof=Devel/DProf='
+ -e 's=devel/dprof=Devel/DProf='\
+ -e 's=file/=='\
+ -e 's=File/=='\
+ -e 's=glob=='\
+ -e 's=Glob=='
}
static_ext=$(repair "$static_ext")
extensions=$(repair "$extensions")
sh -c 'if test ! -d /tmp; then mkdir /tmp; fi'
cp djgpp.c config.over ..
cd ..
-mv ext/B/defsu* ext/B/defsubsh.PL
echo Running sed...
sh djgpp/djgppsed.sh
SSTAT='s=\.\(stat\.\)=_\1=g'
STMP2='s=tmp2=tm2=g'
SPACKLIST='s=\.\(packlist\)=_\1=g'
-SDEFSUB='s=defsubs\.h=defsubsh=g'
-SPLPLI='s=PL/;=PL/i;=g'
sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure
sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH
sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm
sed -e $SPACKLIST lib/ExtUtils/inst >s; mv -f s lib/ExtUtils/inst
sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t
-sed -e $SDEFSUB ext/B/Makefile.PL >s; mv -f s ext/B/Makefile.PL
-sed -e $SDEFSUB ext/B/B.xs >s; mv -f s ext/B/B.xs
-sed -e $SDEFSUB -e $SPLPLI ext/B/defsubsh.PL >s; mv -f s ext/B/defsubsh.PL
#endif
Uid_t fileuid;
Gid_t filegid;
+ IO *io = GvIOp(gv);
if (!PL_argvoutgv)
PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+ if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
+ IoFLAGS(io) &= ~IOf_START;
+ if (PL_inplace) {
+ if (!PL_argvout_stack)
+ PL_argvout_stack = newAV();
+ av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv));
+ }
+ }
if (PL_filemode & (S_ISUID|S_ISGID)) {
PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */
#ifdef HAS_FCHMOD
SETERRNO(0,0); /* in case sprintf set errno */
#ifdef VMS
if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
- O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) {
+ O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp))
#else
if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
- O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
+ O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp))
#endif
+ {
if (ckWARN_d(WARN_INPLACE))
Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s",
PL_oldname, Strerror(errno) );
}
}
}
+ if (io && (IoFLAGS(io) & IOf_ARGV))
+ IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
+ if (io && (IoFLAGS(io) & IOf_ARGV)
+ && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
+ {
+ GV *oldout = (GV*)av_pop(PL_argvout_stack);
+ setdefout(oldout);
+ SvREFCNT_dec(oldout);
+ return Nullfp;
+ }
setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
}
return Nullfp;
{
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return TRUE;
case SVt_IV:
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- tmpgv = cGVOP->op_gv;
+ tmpgv = cGVOP_gv;
do_fstat:
io = GvIO(tmpgv);
if (io && IoIFP(io)) {
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- if (cGVOP->op_gv == PL_defgv) {
+ if (cGVOP_gv == PL_defgv) {
if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
return PL_laststatval;
Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
int fd, int do_report)
{
+#ifdef MACOS_TRADITIONAL
+ Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
+#else
register char **a;
char *tmps;
STRLEN n_a;
}
}
do_execfree();
+#endif
return FALSE;
}
}
}
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
bool
Perl_do_exec(pTHX_ char *cmd)
bool
Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective)
{
+#ifdef MACOS_TRADITIONAL
+ /* This is simply not correct for AppleShare, but fix it yerself. */
+ return TRUE;
+#else
if (testgid == (effective ? PL_egid : PL_gid))
return TRUE;
#ifdef HAS_GETGROUPS
}
#endif
return FALSE;
+#endif
}
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
((UV) s[offset + 1] << 16) +
( s[offset + 2] << 8);
}
-#ifdef HAS_QUAD
+#ifdef UV_IS_QUAD
else if (size == 64) {
dTHR;
if (ckWARN(WARN_PORTABLE))
((UV) s[offset + 1] << 16) +
( s[offset + 2] << 8) +
s[offset + 3];
-#ifdef HAS_QUAD
+#ifdef UV_IS_QUAD
else if (size == 64) {
dTHR;
if (ckWARN(WARN_PORTABLE))
s[offset+2] = (lval >> 8) & 0xff;
s[offset+3] = lval & 0xff;
}
-#ifdef HAS_QUAD
+#ifdef UV_IS_QUAD
else if (size == 64) {
dTHR;
if (ckWARN(WARN_PORTABLE))
#define PERL_SYS_TERM() MALLOC_TERM
#define dXSUB_SYS
-#define TMPPATH "plXXXXXX"
/*
* 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were
Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
dTHR;
- PerlIO_printf(file, "%*s", level*PL_dumpindent, "");
+ PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
PerlIO_printf(file, "%-4d", o->op_seq);
else
PerlIO_printf(file, " ");
- PerlIO_printf(file, "%*sTYPE = %s ===> ", PL_dumpindent*level-4, "", PL_op_name[o->op_type]);
+ PerlIO_printf(file,
+ "%*sTYPE = %s ===> ",
+ (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]);
if (o->op_next) {
if (o->op_seq)
PerlIO_printf(file, "%d\n", o->op_next->op_seq);
}
switch (o->op_type) {
+ case OP_AELEMFAST:
case OP_GVSV:
case OP_GV:
- if (cGVOPo->op_gv) {
+#ifdef USE_ITHREADS
+ Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix);
+#else
+ if (cSVOPo->op_sv) {
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
- gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
+ gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
else
Perl_dump_indent(aTHX_ level, file, "GV = NULL\n");
+#endif
break;
case OP_CONST:
+ Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
+ break;
case OP_METHOD_NAMED:
Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
break;
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
- if (cCOPo->cop_line)
- Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",cCOPo->cop_line);
+ if (CopLINE(cCOPo))
+ Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
+ if (CopSTASHPV(cCOPo))
+ Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
+ CopSTASHPV(cCOPo));
if (cCOPo->cop_label)
- Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",cCOPo->cop_label);
+ Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
+ cCOPo->cop_label);
break;
case OP_ENTERLOOP:
Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
case OP_SUBST:
do_pmop_dump(level, file, cPMOPo);
break;
+ case OP_LEAVE:
+ case OP_LEAVEEVAL:
+ case OP_LEAVESUB:
+ case OP_LEAVESUBLV:
+ case OP_LEAVEWRITE:
+ case OP_SCOPE:
+ if (o->op_private & OPpREFCOUNTED)
+ Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ);
+ break;
default:
break;
}
Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
for (; mg; mg = mg->mg_moremagic) {
- Perl_dump_indent(aTHX_ level, file, " MAGIC = 0x%lx\n", (long)mg);
+ Perl_dump_indent(aTHX_ level, file,
+ " MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
if (mg->mg_virtual) {
MGVTBL *v = mg->mg_virtual;
char *s = 0;
if (s)
Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s);
else
- Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%lx\n", (long)v);
+ Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v));
}
else
Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n");
Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
}
if (mg->mg_obj) {
- Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%lx\n", (long)mg->mg_obj);
+ Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
if (mg->mg_flags & MGf_REFCOUNTED)
do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
}
if (mg->mg_len)
Perl_dump_indent(aTHX_ level, file, " MG_LEN = %d\n", mg->mg_len);
if (mg->mg_ptr) {
- Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%lx", (long)mg->mg_ptr);
+ Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
if (mg->mg_len >= 0) {
SV *sv = newSVpvn("", 0);
PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
void
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv)
{
- Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv);
+ Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && HvNAME(sv))
PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv));
else
void
Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
{
- Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv);
+ Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv))
PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
else
void
Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
{
- Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv);
+ Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
PerlIO_printf(file, "\t\"");
if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
PerlIO_printf(file, "PVIO%s\n", s);
break;
default:
- PerlIO_printf(file, "UNKNOWN(0x%x) %s\n", type, s);
+ PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
return;
}
if (type >= SVt_PVIV || type == SVt_IV) {
Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
- do_gv_dump(level, file, " FILEGV", CvFILEGV(sv));
+ Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
#ifdef USE_THREADS
Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
- Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %"IVdf"\n", (IV)GvLASTEXPR(sv));
+ Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv));
Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv));
+ Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv));
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
- do_gv_dump (level, file, " FILEGV", GvFILEGV(sv));
do_gv_dump (level, file, " EGV", GvEGV(sv));
break;
case SVt_PVIO:
#if !defined(PERL_OBJECT)
#if !defined(PERL_IMPLICIT_CONTEXT)
+#if defined(PERL_IMPLICIT_SYS)
+#else
+#endif
+#if defined(USE_ITHREADS)
+# if defined(PERL_IMPLICIT_SYS)
+# endif
+#endif
+#if defined(MYMALLOC)
+#define malloced_size Perl_malloced_size
+#endif
#if defined(PERL_OBJECT)
#endif
+#if defined(PERL_OBJECT)
+#else
+#endif
#define amagic_call Perl_amagic_call
#define Gv_AMupdate Perl_Gv_AMupdate
#define append_elem Perl_append_elem
#define cxinc Perl_cxinc
#define deb Perl_deb
#define vdeb Perl_vdeb
-#define deb_growlevel Perl_deb_growlevel
#define debprofdump Perl_debprofdump
#define debop Perl_debop
#define debstack Perl_debstack
#define magic_sizepack Perl_magic_sizepack
#define magic_wipepack Perl_magic_wipepack
#define magicname Perl_magicname
-#if defined(MYMALLOC)
-#define malloced_size Perl_malloced_size
-#endif
#define markstack_grow Perl_markstack_grow
#if defined(USE_LOCALE_COLLATE)
#define mem_collxfrm Perl_mem_collxfrm
#define newHVhv Perl_newHVhv
#define newIO Perl_newIO
#define newLISTOP Perl_newLISTOP
+#define newPADOP Perl_newPADOP
#define newPMOP Perl_newPMOP
#define newPVOP Perl_newPVOP
#define newRV Perl_newRV
#define pad_swipe Perl_pad_swipe
#define peep Perl_peep
#if defined(PERL_OBJECT)
-#else
+#endif
#if defined(USE_THREADS)
#define new_struct_thread Perl_new_struct_thread
#endif
-#endif
#define call_atexit Perl_call_atexit
#define call_argv Perl_call_argv
#define call_method Perl_call_method
#define save_hptr Perl_save_hptr
#define save_I16 Perl_save_I16
#define save_I32 Perl_save_I32
+#define save_I8 Perl_save_I8
#define save_int Perl_save_int
#define save_item Perl_save_item
#define save_iv Perl_save_iv
#define save_op Perl_save_op
#define save_scalar Perl_save_scalar
#define save_pptr Perl_save_pptr
+#define save_vptr Perl_save_vptr
#define save_re_context Perl_save_re_context
#define save_sptr Perl_save_sptr
#define save_svref Perl_save_svref
#define vivify_defelem Perl_vivify_defelem
#define vivify_ref Perl_vivify_ref
#define wait4pid Perl_wait4pid
+#define report_uninit Perl_report_uninit
#define warn Perl_warn
#define vwarn Perl_vwarn
#define warner Perl_warner
#define newMYSUB Perl_newMYSUB
#define my_attrs Perl_my_attrs
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#define cx_dup Perl_cx_dup
+#define si_dup Perl_si_dup
+#define ss_dup Perl_ss_dup
+#define any_dup Perl_any_dup
+#define he_dup Perl_he_dup
+#define re_dup Perl_re_dup
+#define fp_dup Perl_fp_dup
+#define dirp_dup Perl_dirp_dup
+#define gp_dup Perl_gp_dup
+#define mg_dup Perl_mg_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#define ptr_table_new Perl_ptr_table_new
+#define ptr_table_fetch Perl_ptr_table_fetch
+#define ptr_table_store Perl_ptr_table_store
+#define ptr_table_split Perl_ptr_table_split
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
#define avhv_index_sv S_avhv_index_sv
#define simplify_sort S_simplify_sort
#define is_handle_constructor S_is_handle_constructor
#define gv_ename S_gv_ename
+#define cv_dump S_cv_dump
#define cv_clone2 S_cv_clone2
#define scalar_mod_type S_scalar_mod_type
#define my_kid S_my_kid
#define regwhite S_regwhite
#define nextchar S_nextchar
#define dumpuntil S_dumpuntil
+#define put_byte S_put_byte
#define scan_commit S_scan_commit
+#define cl_anything S_cl_anything
+#define cl_is_anything S_cl_is_anything
+#define cl_init S_cl_init
+#define cl_init_zero S_cl_init_zero
+#define cl_and S_cl_and
+#define cl_or S_cl_or
#define study_chunk S_study_chunk
#define add_data S_add_data
#define re_croak2 S_re_croak2
#define cache_re S_cache_re
#define reghop S_reghop
#define reghopmaybe S_reghopmaybe
+#define find_byclass S_find_byclass
#endif
#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
#define debprof S_debprof
#define xstat S_xstat
# endif
#endif
+#if defined(PERL_OBJECT)
+#endif
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_concat Perl_ck_concat
#else /* PERL_IMPLICIT_CONTEXT */
+#if defined(PERL_IMPLICIT_SYS)
+#else
+#endif
+#if defined(USE_ITHREADS)
+# if defined(PERL_IMPLICIT_SYS)
+# endif
+#endif
+#if defined(MYMALLOC)
+#define malloced_size Perl_malloced_size
+#endif
+#if defined(PERL_OBJECT)
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d)
#define Gv_AMupdate(a) Perl_Gv_AMupdate(aTHX_ a)
#define get_ppaddr() Perl_get_ppaddr(aTHX)
#define cxinc() Perl_cxinc(aTHX)
#define vdeb(a,b) Perl_vdeb(aTHX_ a,b)
-#define deb_growlevel() Perl_deb_growlevel(aTHX)
#define debprofdump() Perl_debprofdump(aTHX)
#define debop(a) Perl_debop(aTHX_ a)
#define debstack() Perl_debstack(aTHX)
#define magic_sizepack(a,b) Perl_magic_sizepack(aTHX_ a,b)
#define magic_wipepack(a,b) Perl_magic_wipepack(aTHX_ a,b)
#define magicname(a,b,c) Perl_magicname(aTHX_ a,b,c)
-#if defined(MYMALLOC)
-#define malloced_size Perl_malloced_size
-#endif
#define markstack_grow() Perl_markstack_grow(aTHX)
#if defined(USE_LOCALE_COLLATE)
#define mem_collxfrm(a,b,c) Perl_mem_collxfrm(aTHX_ a,b,c)
#define newHVhv(a) Perl_newHVhv(aTHX_ a)
#define newIO() Perl_newIO(aTHX)
#define newLISTOP(a,b,c,d) Perl_newLISTOP(aTHX_ a,b,c,d)
+#define newPADOP(a,b,c) Perl_newPADOP(aTHX_ a,b,c)
#define newPMOP(a,b) Perl_newPMOP(aTHX_ a,b)
#define newPVOP(a,b,c) Perl_newPVOP(aTHX_ a,b,c)
#define newRV(a) Perl_newRV(aTHX_ a)
#define pad_swipe(a) Perl_pad_swipe(aTHX_ a)
#define peep(a) Perl_peep(aTHX_ a)
#if defined(PERL_OBJECT)
-#else
+#endif
#if defined(USE_THREADS)
#define new_struct_thread(a) Perl_new_struct_thread(aTHX_ a)
#endif
-#endif
#define call_atexit(a,b) Perl_call_atexit(aTHX_ a,b)
#define call_argv(a,b,c) Perl_call_argv(aTHX_ a,b,c)
#define call_method(a,b) Perl_call_method(aTHX_ a,b)
#define save_hptr(a) Perl_save_hptr(aTHX_ a)
#define save_I16(a) Perl_save_I16(aTHX_ a)
#define save_I32(a) Perl_save_I32(aTHX_ a)
+#define save_I8(a) Perl_save_I8(aTHX_ a)
#define save_int(a) Perl_save_int(aTHX_ a)
#define save_item(a) Perl_save_item(aTHX_ a)
#define save_iv(a) Perl_save_iv(aTHX_ a)
#define save_op() Perl_save_op(aTHX)
#define save_scalar(a) Perl_save_scalar(aTHX_ a)
#define save_pptr(a) Perl_save_pptr(aTHX_ a)
+#define save_vptr(a) Perl_save_vptr(aTHX_ a)
#define save_re_context() Perl_save_re_context(aTHX)
#define save_sptr(a) Perl_save_sptr(aTHX_ a)
#define save_svref(a) Perl_save_svref(aTHX_ a)
#define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a)
#define vivify_ref(a,b) Perl_vivify_ref(aTHX_ a,b)
#define wait4pid(a,b,c) Perl_wait4pid(aTHX_ a,b,c)
+#define report_uninit() Perl_report_uninit(aTHX)
#define vwarn(a,b) Perl_vwarn(aTHX_ a,b)
#define vwarner(a,b,c) Perl_vwarner(aTHX_ a,b,c)
#define watch(a) Perl_watch(aTHX_ a)
#define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e)
#define my_attrs(a,b) Perl_my_attrs(aTHX_ a,b)
#define boot_core_xsutils() Perl_boot_core_xsutils(aTHX)
+#if defined(USE_ITHREADS)
+#define cx_dup(a,b,c) Perl_cx_dup(aTHX_ a,b,c)
+#define si_dup(a) Perl_si_dup(aTHX_ a)
+#define ss_dup(a) Perl_ss_dup(aTHX_ a)
+#define any_dup(a,b) Perl_any_dup(aTHX_ a,b)
+#define he_dup(a,b) Perl_he_dup(aTHX_ a,b)
+#define re_dup(a) Perl_re_dup(aTHX_ a)
+#define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b)
+#define dirp_dup(a) Perl_dirp_dup(aTHX_ a)
+#define gp_dup(a) Perl_gp_dup(aTHX_ a)
+#define mg_dup(a) Perl_mg_dup(aTHX_ a)
+#define sv_dup(a) Perl_sv_dup(aTHX_ a)
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b)
+#endif
+#define ptr_table_new() Perl_ptr_table_new(aTHX)
+#define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b)
+#define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c)
+#define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a)
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
#define avhv_index_sv(a) S_avhv_index_sv(aTHX_ a)
#define simplify_sort(a) S_simplify_sort(aTHX_ a)
#define is_handle_constructor(a,b) S_is_handle_constructor(aTHX_ a,b)
#define gv_ename(a) S_gv_ename(aTHX_ a)
+#define cv_dump(a) S_cv_dump(aTHX_ a)
#define cv_clone2(a,b) S_cv_clone2(aTHX_ a,b)
#define scalar_mod_type(a,b) S_scalar_mod_type(aTHX_ a,b)
#define my_kid(a,b) S_my_kid(aTHX_ a,b)
#define regwhite(a,b) S_regwhite(aTHX_ a,b)
#define nextchar() S_nextchar(aTHX)
#define dumpuntil(a,b,c,d,e) S_dumpuntil(aTHX_ a,b,c,d,e)
+#define put_byte(a,b) S_put_byte(aTHX_ a,b)
#define scan_commit(a) S_scan_commit(aTHX_ a)
+#define cl_anything(a) S_cl_anything(aTHX_ a)
+#define cl_is_anything(a) S_cl_is_anything(aTHX_ a)
+#define cl_init(a) S_cl_init(aTHX_ a)
+#define cl_init_zero(a) S_cl_init_zero(aTHX_ a)
+#define cl_and(a,b) S_cl_and(aTHX_ a,b)
+#define cl_or(a,b) S_cl_or(aTHX_ a,b)
#define study_chunk(a,b,c,d,e) S_study_chunk(aTHX_ a,b,c,d,e)
#define add_data(a,b) S_add_data(aTHX_ a,b)
#define regpposixcc(a) S_regpposixcc(aTHX_ a)
#define cache_re(a) S_cache_re(aTHX_ a)
#define reghop(a,b) S_reghop(aTHX_ a,b)
#define reghopmaybe(a,b) S_reghopmaybe(aTHX_ a,b)
+#define find_byclass(a,b,c,d,e,f) S_find_byclass(aTHX_ a,b,c,d,e,f)
#endif
#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
#define debprof(a) S_debprof(aTHX_ a)
#define xstat(a) S_xstat(aTHX_ a)
# endif
#endif
+#if defined(PERL_OBJECT)
+#endif
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
#endif /* PERL_IMPLICIT_CONTEXT */
#else /* PERL_OBJECT */
+#if defined(PERL_IMPLICIT_SYS)
+#else
+#endif
+#if defined(USE_ITHREADS)
+# if defined(PERL_IMPLICIT_SYS)
+# endif
+#endif
+#if defined(MYMALLOC)
+#define malloc Perl_malloc
+#define calloc Perl_calloc
+#define realloc Perl_realloc
+#define mfree Perl_mfree
+#define malloced_size Perl_malloced_size
+#endif
#if defined(PERL_OBJECT)
#endif
+#if defined(PERL_OBJECT)
+#else
+#endif
#define Perl_amagic_call CPerlObj::Perl_amagic_call
#define amagic_call Perl_amagic_call
#define Perl_Gv_AMupdate CPerlObj::Perl_Gv_AMupdate
#define deb Perl_deb
#define Perl_vdeb CPerlObj::Perl_vdeb
#define vdeb Perl_vdeb
-#define Perl_deb_growlevel CPerlObj::Perl_deb_growlevel
-#define deb_growlevel Perl_deb_growlevel
#define Perl_debprofdump CPerlObj::Perl_debprofdump
#define debprofdump Perl_debprofdump
#define Perl_debop CPerlObj::Perl_debop
#define magic_wipepack Perl_magic_wipepack
#define Perl_magicname CPerlObj::Perl_magicname
#define magicname Perl_magicname
-#if defined(MYMALLOC)
-#define Perl_malloced_size CPerlObj::Perl_malloced_size
-#define malloced_size Perl_malloced_size
-#endif
#define Perl_markstack_grow CPerlObj::Perl_markstack_grow
#define markstack_grow Perl_markstack_grow
#if defined(USE_LOCALE_COLLATE)
#define newIO Perl_newIO
#define Perl_newLISTOP CPerlObj::Perl_newLISTOP
#define newLISTOP Perl_newLISTOP
+#define Perl_newPADOP CPerlObj::Perl_newPADOP
+#define newPADOP Perl_newPADOP
#define Perl_newPMOP CPerlObj::Perl_newPMOP
#define newPMOP Perl_newPMOP
#define Perl_newPVOP CPerlObj::Perl_newPVOP
#define Perl_peep CPerlObj::Perl_peep
#define peep Perl_peep
#if defined(PERL_OBJECT)
-#define perl_construct CPerlObj::perl_construct
-#define perl_destruct CPerlObj::perl_destruct
-#define perl_free CPerlObj::perl_free
-#define perl_run CPerlObj::perl_run
-#define perl_parse CPerlObj::perl_parse
-#else
-#define perl_alloc CPerlObj::perl_alloc
-#define perl_construct CPerlObj::perl_construct
-#define perl_destruct CPerlObj::perl_destruct
-#define perl_free CPerlObj::perl_free
-#define perl_run CPerlObj::perl_run
-#define perl_parse CPerlObj::perl_parse
+#define Perl_construct CPerlObj::Perl_construct
+#define Perl_destruct CPerlObj::Perl_destruct
+#define Perl_free CPerlObj::Perl_free
+#define Perl_run CPerlObj::Perl_run
+#define Perl_parse CPerlObj::Perl_parse
+#endif
#if defined(USE_THREADS)
#define Perl_new_struct_thread CPerlObj::Perl_new_struct_thread
#define new_struct_thread Perl_new_struct_thread
#endif
-#endif
#define Perl_call_atexit CPerlObj::Perl_call_atexit
#define call_atexit Perl_call_atexit
#define Perl_call_argv CPerlObj::Perl_call_argv
#define save_I16 Perl_save_I16
#define Perl_save_I32 CPerlObj::Perl_save_I32
#define save_I32 Perl_save_I32
+#define Perl_save_I8 CPerlObj::Perl_save_I8
+#define save_I8 Perl_save_I8
#define Perl_save_int CPerlObj::Perl_save_int
#define save_int Perl_save_int
#define Perl_save_item CPerlObj::Perl_save_item
#define save_scalar Perl_save_scalar
#define Perl_save_pptr CPerlObj::Perl_save_pptr
#define save_pptr Perl_save_pptr
+#define Perl_save_vptr CPerlObj::Perl_save_vptr
+#define save_vptr Perl_save_vptr
#define Perl_save_re_context CPerlObj::Perl_save_re_context
#define save_re_context Perl_save_re_context
#define Perl_save_sptr CPerlObj::Perl_save_sptr
#define vivify_ref Perl_vivify_ref
#define Perl_wait4pid CPerlObj::Perl_wait4pid
#define wait4pid Perl_wait4pid
+#define Perl_report_uninit CPerlObj::Perl_report_uninit
+#define report_uninit Perl_report_uninit
#define Perl_warn CPerlObj::Perl_warn
#define warn Perl_warn
#define Perl_vwarn CPerlObj::Perl_vwarn
#if defined(MYMALLOC)
#define Perl_dump_mstats CPerlObj::Perl_dump_mstats
#define dump_mstats Perl_dump_mstats
-#define Perl_malloc CPerlObj::Perl_malloc
-#define malloc Perl_malloc
-#define Perl_calloc CPerlObj::Perl_calloc
-#define calloc Perl_calloc
-#define Perl_realloc CPerlObj::Perl_realloc
-#define realloc Perl_realloc
-#define Perl_mfree CPerlObj::Perl_mfree
-#define mfree Perl_mfree
#endif
#define Perl_safesysmalloc CPerlObj::Perl_safesysmalloc
#define safesysmalloc Perl_safesysmalloc
#define my_attrs Perl_my_attrs
#define Perl_boot_core_xsutils CPerlObj::Perl_boot_core_xsutils
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#define Perl_cx_dup CPerlObj::Perl_cx_dup
+#define cx_dup Perl_cx_dup
+#define Perl_si_dup CPerlObj::Perl_si_dup
+#define si_dup Perl_si_dup
+#define Perl_ss_dup CPerlObj::Perl_ss_dup
+#define ss_dup Perl_ss_dup
+#define Perl_any_dup CPerlObj::Perl_any_dup
+#define any_dup Perl_any_dup
+#define Perl_he_dup CPerlObj::Perl_he_dup
+#define he_dup Perl_he_dup
+#define Perl_re_dup CPerlObj::Perl_re_dup
+#define re_dup Perl_re_dup
+#define Perl_fp_dup CPerlObj::Perl_fp_dup
+#define fp_dup Perl_fp_dup
+#define Perl_dirp_dup CPerlObj::Perl_dirp_dup
+#define dirp_dup Perl_dirp_dup
+#define Perl_gp_dup CPerlObj::Perl_gp_dup
+#define gp_dup Perl_gp_dup
+#define Perl_mg_dup CPerlObj::Perl_mg_dup
+#define mg_dup Perl_mg_dup
+#define Perl_sv_dup CPerlObj::Perl_sv_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#define Perl_ptr_table_new CPerlObj::Perl_ptr_table_new
+#define ptr_table_new Perl_ptr_table_new
+#define Perl_ptr_table_fetch CPerlObj::Perl_ptr_table_fetch
+#define ptr_table_fetch Perl_ptr_table_fetch
+#define Perl_ptr_table_store CPerlObj::Perl_ptr_table_store
+#define ptr_table_store Perl_ptr_table_store
+#define Perl_ptr_table_split CPerlObj::Perl_ptr_table_split
+#define ptr_table_split Perl_ptr_table_split
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
#define S_avhv_index_sv CPerlObj::S_avhv_index_sv
#define is_handle_constructor S_is_handle_constructor
#define S_gv_ename CPerlObj::S_gv_ename
#define gv_ename S_gv_ename
+#define S_cv_dump CPerlObj::S_cv_dump
+#define cv_dump S_cv_dump
#define S_cv_clone2 CPerlObj::S_cv_clone2
#define cv_clone2 S_cv_clone2
#define S_scalar_mod_type CPerlObj::S_scalar_mod_type
#define nextchar S_nextchar
#define S_dumpuntil CPerlObj::S_dumpuntil
#define dumpuntil S_dumpuntil
+#define S_put_byte CPerlObj::S_put_byte
+#define put_byte S_put_byte
#define S_scan_commit CPerlObj::S_scan_commit
#define scan_commit S_scan_commit
+#define S_cl_anything CPerlObj::S_cl_anything
+#define cl_anything S_cl_anything
+#define S_cl_is_anything CPerlObj::S_cl_is_anything
+#define cl_is_anything S_cl_is_anything
+#define S_cl_init CPerlObj::S_cl_init
+#define cl_init S_cl_init
+#define S_cl_init_zero CPerlObj::S_cl_init_zero
+#define cl_init_zero S_cl_init_zero
+#define S_cl_and CPerlObj::S_cl_and
+#define cl_and S_cl_and
+#define S_cl_or CPerlObj::S_cl_or
+#define cl_or S_cl_or
#define S_study_chunk CPerlObj::S_study_chunk
#define study_chunk S_study_chunk
#define S_add_data CPerlObj::S_add_data
#define reghop S_reghop
#define S_reghopmaybe CPerlObj::S_reghopmaybe
#define reghopmaybe S_reghopmaybe
+#define S_find_byclass CPerlObj::S_find_byclass
+#define find_byclass S_find_byclass
#endif
#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
#define S_debprof CPerlObj::S_debprof
#define xstat S_xstat
# endif
#endif
+#if defined(PERL_OBJECT)
+#endif
#define Perl_ck_anoncode CPerlObj::Perl_ck_anoncode
#define ck_anoncode Perl_ck_anoncode
#define Perl_ck_bitop CPerlObj::Perl_ck_bitop
seek DATA, $END, 0; # so we may restart
while (<DATA>) {
chomp;
+ next if /^:/;
while (s|\\$||) {
$_ .= <DATA>;
chomp;
my $ret = "";
if (@_ == 1) {
my $arg = shift;
- $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/
- or $arg =~ /^\s*(public|protected|private):/;
+ $ret .= "$arg\n";
}
else {
my ($flags,$retval,$func,@args) = @_;
$func = "S_$func";
}
else {
- $retval = "VIRTUAL $retval";
+ $retval = "PERL_CALLCONV $retval";
if ($flags =~ /p/) {
$func = "Perl_$func";
}
my $ret = "";
if (@_ > 1) {
my ($flags,$retval,$func,@args) = @_;
- unless ($flags =~ /s/) {
+ unless ($flags =~ /[sx]/) {
$func = "Perl_$func" if $flags =~ /p/;
$ret = "$func\n";
}
else {
my ($flags,$retval,$func,@args) = @_;
if ($flags =~ /s/) {
- $ret .= hide("S_$func","CPerlObj::S_$func");
+ $ret .= hide("S_$func","CPerlObj::S_$func") if $flags !~ /j/;
$ret .= hide($func,"S_$func");
}
elsif ($flags =~ /p/) {
- $ret .= hide("Perl_$func","CPerlObj::Perl_$func");
+ $ret .= hide("Perl_$func","CPerlObj::Perl_$func") if $flags !~ /j/;
$ret .= hide($func,"Perl_$func");
}
else {
- $ret .= hide($func,"CPerlObj::$func");
+ $ret .= hide($func,"CPerlObj::$func") if $flags !~ /j/;
}
}
$ret;
# endif /* USE_THREADS */
#else /* !MULTIPLICITY */
-/* cases 1, 4 and 6 above */
+
+# if defined(PERL_OBJECT)
+/* case 6 above */
+
+END
+
+for $sym (sort keys %thread) {
+ print EM multon($sym,'T','aTHXo->interp.');
+}
+
+
+for $sym (sort keys %intrp) {
+ print EM multon($sym,'I','aTHXo->interp.');
+}
+
+print EM <<'END';
+
+# else /* !PERL_OBJECT */
+
+/* cases 1 and 4 above */
END
print EM <<'END';
-# if defined(USE_THREADS)
+# if defined(USE_THREADS)
/* case 4 above */
END
print EM <<'END';
-# else /* !USE_THREADS */
-/* cases 1 and 6 above */
+# else /* !USE_THREADS */
+/* case 1 above */
END
print EM <<'END';
-# endif /* USE_THREADS */
+# endif /* USE_THREADS */
+# endif /* PERL_OBJECT */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
}
else {
my ($flags,$retval,$func,@args) = @_;
- unless ($flags =~ /s/) {
+ unless ($flags =~ /[js]/) {
if ($flags =~ /p/) {
$ret .= undefine("Perl_$func") . hide("Perl_$func","pPerl->Perl_$func");
$ret .= undefine($func) . hide($func,"Perl_$func");
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \
- { return &(aTHXo->PL_##v); }
+ { return &(aTHXo->interp.v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \
- { return &(aTHXo->PL_##v); }
+ { return &(aTHXo->interp.v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
else {
my ($flags,$retval,$func,@args) = @_;
return $ret if exists $skipapi_funcs{$func};
- unless ($flags =~ /s/) {
+ unless ($flags =~ /[js]/) {
$ret .= "\n";
my $addctx = 1 if $flags =~ /n/;
if ($flags =~ /p/) {
dTHXo;
va_list(arglist);
va_start(arglist, format);
- return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist);
+ return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist);
}
END_EXTERN_C
__END__
-# 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:
-# s static function, should have an S_ prefix in source
-# file
-# n has no implicit interpreter/thread context argument
-# p function has a Perl_ prefix
-# r function never returns
-# o has no compatibility macro (#define foo Perl_foo)
-#
-# Individual flags may be separated by whitespace.
-#
-# New global functions should be added at the end for binary compatibility
-# in some configurations.
-#
-# TODO: 1) Add a flag to mark the functions that are part of the public API.
-# 2) Add a field for documentation, so that L<perlguts/"API LISTING">
-# may be autogenerated.
-#
+: 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:
+: s static function, should have an S_ prefix in source
+: file
+: n has no implicit interpreter/thread context argument
+: p function has a Perl_ prefix
+: r function never returns
+: o has no compatibility macro (#define foo Perl_foo)
+: j not a member of CPerlObj
+: x not exported
+:
+: Individual flags may be separated by whitespace.
+:
+: New global functions should be added at the end for binary compatibility
+: in some configurations.
+:
+: TODO: 1) Add a flag to mark the functions that are part of the public API.
+: 2) Add a field for documentation, so that L<perlguts/"API LISTING">
+: may be autogenerated.
+
+START_EXTERN_C
+
+#if defined(PERL_IMPLICIT_SYS)
+jno |PerlInterpreter* |perl_alloc_using \
+ |struct IPerlMem* m|struct IPerlMem* ms \
+ |struct IPerlMem* mp|struct IPerlEnv* e \
+ |struct IPerlStdIO* io|struct IPerlLIO* lio \
+ |struct IPerlDir* d|struct IPerlSock* s \
+ |struct IPerlProc* p
+#else
+jno |PerlInterpreter* |perl_alloc
+#endif
+jno |void |perl_construct |PerlInterpreter* interp
+jno |void |perl_destruct |PerlInterpreter* interp
+jno |void |perl_free |PerlInterpreter* interp
+jno |int |perl_run |PerlInterpreter* interp
+jno |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \
+ |int argc|char** argv|char** env
+#if defined(USE_ITHREADS)
+jno |PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags
+# if defined(PERL_IMPLICIT_SYS)
+jno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \
+ |struct IPerlMem* m|struct IPerlMem* ms \
+ |struct IPerlMem* mp|struct IPerlEnv* e \
+ |struct IPerlStdIO* io|struct IPerlLIO* lio \
+ |struct IPerlDir* d|struct IPerlSock* s \
+ |struct IPerlProc* p
+# endif
+#endif
+
+#if defined(MYMALLOC)
+jnop |Malloc_t|malloc |MEM_SIZE nbytes
+jnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size
+jnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes
+jnop |Free_t |mfree |Malloc_t where
+jnp |MEM_SIZE|malloced_size |void *p
+#endif
+END_EXTERN_C
+
+/* functions with flag 'n' should come before here */
#if defined(PERL_OBJECT)
+class CPerlObj {
public:
+ struct interpreter interp;
+ CPerlObj(IPerlMem*, IPerlMem*, IPerlMem*, IPerlEnv*, IPerlStdIO*,
+ IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
+ void* operator new(size_t nSize, IPerlMem *pvtbl);
+ static void operator delete(void* pPerl, IPerlMem *pvtbl);
+ int do_aspawn (void *vreally, void **vmark, void **vsp);
+#endif
+#if defined(PERL_OBJECT)
+public:
+#else
+START_EXTERN_C
#endif
+# include "pp_proto.h"
p |SV* |amagic_call |SV* left|SV* right|int method|int dir
p |bool |Gv_AMupdate |HV* stash
p |OP* |append_elem |I32 optype|OP* head|OP* tail
pr |void |croak |const char* pat|...
pr |void |vcroak |const char* pat|va_list* args
#if defined(PERL_IMPLICIT_CONTEXT)
-npr |void |croak_nocontext|const char* pat|...
+nrp |void |croak_nocontext|const char* pat|...
np |OP* |die_nocontext |const char* pat|...
np |void |deb_nocontext |const char* pat|...
np |char* |form_nocontext |const char* pat|...
p |I32 |cxinc
p |void |deb |const char* pat|...
p |void |vdeb |const char* pat|va_list* args
-p |void |deb_growlevel
p |void |debprofdump
p |I32 |debop |OP* o
p |I32 |debstack
p |U32 |magic_sizepack |SV* sv|MAGIC* mg
p |int |magic_wipepack |SV* sv|MAGIC* mg
p |void |magicname |char* sym|char* name|I32 namlen
-#if defined(MYMALLOC)
-np |MEM_SIZE|malloced_size |void *p
-#endif
p |void |markstack_grow
#if defined(USE_LOCALE_COLLATE)
p |char* |mem_collxfrm |const char* s|STRLEN len|STRLEN* xlen
p |HV* |newHVhv |HV* hv
p |IO* |newIO
p |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last
+p |OP* |newPADOP |I32 type|I32 flags|SV* sv
p |OP* |newPMOP |I32 type|I32 flags
p |OP* |newPVOP |I32 type|I32 flags|char* pv
p |SV* |newRV |SV* pref
p |void |pad_swipe |PADOFFSET po
p |void |peep |OP* o
#if defined(PERL_OBJECT)
-no |void |perl_construct
-no |void |perl_destruct
-no |void |perl_free
-no |int |perl_run
-no |int |perl_parse |XSINIT_t xsinit \
- |int argc|char** argv|char** env
-#else
-no |PerlInterpreter* |perl_alloc
-no |void |perl_construct |PerlInterpreter* sv_interp
-no |void |perl_destruct |PerlInterpreter* sv_interp
-no |void |perl_free |PerlInterpreter* sv_interp
-no |int |perl_run |PerlInterpreter* sv_interp
-no |int |perl_parse |PerlInterpreter* sv_interp|XSINIT_t xsinit \
+ox |void |Perl_construct
+ox |void |Perl_destruct
+ox |void |Perl_free
+ox |int |Perl_run
+ox |int |Perl_parse |XSINIT_t xsinit \
|int argc|char** argv|char** env
+#endif
#if defined(USE_THREADS)
p |struct perl_thread* |new_struct_thread|struct perl_thread *t
#endif
-#endif
p |void |call_atexit |ATEXIT_t fn|void *ptr
p |I32 |call_argv |const char* sub_name|I32 flags|char** argv
p |I32 |call_method |const char* methname|I32 flags
p |void |save_hptr |HV** hptr
p |void |save_I16 |I16* intp
p |void |save_I32 |I32* intp
+p |void |save_I8 |I8* bytep
p |void |save_int |int* intp
p |void |save_item |SV* item
p |void |save_iv |IV* iv
p |void |save_op
p |SV* |save_scalar |GV* gv
p |void |save_pptr |char** pptr
+p |void |save_vptr |void* pptr
p |void |save_re_context
p |void |save_sptr |SV** sptr
p |SV* |save_svref |SV** sptr
|I32 minbits|I32 none
p |UV |swash_fetch |SV *sv|U8 *ptr
p |void |taint_env
-p |void |taint_proper |const char* f|char* s
+p |void |taint_proper |const char* f|const char* s
p |UV |to_utf8_lower |U8 *p
p |UV |to_utf8_upper |U8 *p
p |UV |to_utf8_title |U8 *p
p |void |vivify_defelem |SV* sv
p |void |vivify_ref |SV* sv|U32 to_what
p |I32 |wait4pid |Pid_t pid|int* statusp|int flags
+p |void |report_uninit
p |void |warn |const char* pat|...
p |void |vwarn |const char* pat|va_list* args
p |void |warner |U32 err|const char* pat|...
p |int |yywarn |char* s
#if defined(MYMALLOC)
p |void |dump_mstats |char* s
-pno |Malloc_t|malloc |MEM_SIZE nbytes
-pno |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size
-pno |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes
-pno |Free_t |mfree |Malloc_t where
#endif
-pn |Malloc_t|safesysmalloc |MEM_SIZE nbytes
-pn |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
-pn |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
-pn |Free_t |safesysfree |Malloc_t where
+np |Malloc_t|safesysmalloc |MEM_SIZE nbytes
+np |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
+np |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
+np |Free_t |safesysfree |Malloc_t where
#if defined(LEAKTEST)
-pn |Malloc_t|safexmalloc |I32 x|MEM_SIZE size
-pn |Malloc_t|safexcalloc |I32 x|MEM_SIZE elements|MEM_SIZE size
-pn |Malloc_t|safexrealloc |Malloc_t where|MEM_SIZE size
-pn |void |safexfree |Malloc_t where
+np |Malloc_t|safexmalloc |I32 x|MEM_SIZE size
+np |Malloc_t|safexcalloc |I32 x|MEM_SIZE elements|MEM_SIZE size
+np |Malloc_t|safexrealloc |Malloc_t where|MEM_SIZE size
+np |void |safexfree |Malloc_t where
#endif
#if defined(PERL_GLOBAL_STRUCT)
p |struct perl_vars *|GetVars
p |void |newMYSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block
p |OP * |my_attrs |OP *o|OP *attrs
p |void |boot_core_xsutils
+#if defined(USE_ITHREADS)
+p |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max
+p |PERL_SI*|si_dup |PERL_SI* si
+p |ANY* |ss_dup |PerlInterpreter* proto_perl
+p |void* |any_dup |void* v|PerlInterpreter* proto_perl
+p |HE* |he_dup |HE* e|bool shared
+p |REGEXP*|re_dup |REGEXP* r
+p |PerlIO*|fp_dup |PerlIO* fp|char type
+p |DIR* |dirp_dup |DIR* dp
+p |GP* |gp_dup |GP* gp
+p |MAGIC* |mg_dup |MAGIC* mg
+p |SV* |sv_dup |SV* sstr
+#if defined(HAVE_INTERP_INTERN)
+p |void |sys_intern_dup |struct interp_intern* src \
+ |struct interp_intern* dst
+#endif
+p |PTR_TBL_t*|ptr_table_new
+p |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv
+p |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
+p |void |ptr_table_split|PTR_TBL_t *tbl
+#endif
#if defined(PERL_OBJECT)
protected:
+#else
+END_EXTERN_C
#endif
+
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
s |I32 |avhv_index_sv |SV* sv
#endif
s |void |simplify_sort |OP *o
s |bool |is_handle_constructor |OP *o|I32 argnum
s |char* |gv_ename |GV *gv
+s |void |cv_dump |CV *cv
s |CV* |cv_clone2 |CV *proto|CV *outside
s |bool |scalar_mod_type|OP *o|I32 type
s |OP * |my_kid |OP *o|OP *attrs
s |char*|nextchar
s |regnode*|dumpuntil |regnode *start|regnode *node \
|regnode *last|SV* sv|I32 l
+s |void |put_byte |SV* sv|int c
s |void |scan_commit |struct scan_data_t *data
+s |void |cl_anything |struct regnode_charclass_class *cl
+s |int |cl_is_anything |struct regnode_charclass_class *cl
+s |void |cl_init |struct regnode_charclass_class *cl
+s |void |cl_init_zero |struct regnode_charclass_class *cl
+s |void |cl_and |struct regnode_charclass_class *cl \
+ |struct regnode_charclass_class *and_with
+s |void |cl_or |struct regnode_charclass_class *cl \
+ |struct regnode_charclass_class *or_with
s |I32 |study_chunk |regnode **scanp|I32 *deltap \
|regnode *last|struct scan_data_t *data \
|U32 flags
s |I32 |regrepeat |regnode *p|I32 max
s |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp
s |I32 |regtry |regexp *prog|char *startpos
-s |bool |reginclass |char *p|I32 c
+s |bool |reginclass |regnode *p|I32 c
s |bool |reginclassutf8 |regnode *f|U8* p
s |CHECKPOINT|regcppush |I32 parenfloor
s |char*|regcppop
s |void |cache_re |regexp *prog
s |U8* |reghop |U8 *pos|I32 off
s |U8* |reghopmaybe |U8 *pos|I32 off
+s |char* |find_byclass |regexp * prog|regnode *c|char *s|char *strend|char *startpos|I32 norun
#endif
#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
s |void |incline |char *s
s |int |intuit_method |char *s|GV *gv
s |int |intuit_more |char *s
-s |I32 |lop |I32 f|expectation x|char *s
+s |I32 |lop |I32 f|int x|char *s
s |void |missingterm |char *s
s |void |no_op |char *what|char *s
s |void |set_csh
s |I32 |sublex_push
s |I32 |sublex_start
s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append
-s |SV* |new_constant |char *s|STRLEN len|char *key|SV *sv \
- |SV *pv|char *type
+s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \
+ |SV *pv|const char *type
s |int |ao |int toketype
s |void |depcom
s |char* |incl_perldb
s |void |xstat |int
# endif
#endif
+
+#if defined(PERL_OBJECT)
+};
+#endif
#define PL_Env (PERL_GET_INTERP->IEnv)
#define PL_LIO (PERL_GET_INTERP->ILIO)
#define PL_Mem (PERL_GET_INTERP->IMem)
+#define PL_MemParse (PERL_GET_INTERP->IMemParse)
+#define PL_MemShared (PERL_GET_INTERP->IMemShared)
#define PL_Proc (PERL_GET_INTERP->IProc)
#define PL_Sock (PERL_GET_INTERP->ISock)
#define PL_StdIO (PERL_GET_INTERP->IStdIO)
#define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation)
-#define PL_ampergv (PERL_GET_INTERP->Iampergv)
#define PL_an (PERL_GET_INTERP->Ian)
#define PL_archpat_auto (PERL_GET_INTERP->Iarchpat_auto)
#define PL_argvgv (PERL_GET_INTERP->Iargvgv)
+#define PL_argvout_stack (PERL_GET_INTERP->Iargvout_stack)
#define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv)
#define PL_basetime (PERL_GET_INTERP->Ibasetime)
#define PL_beginav (PERL_GET_INTERP->Ibeginav)
#define PL_bitcount (PERL_GET_INTERP->Ibitcount)
#define PL_bufend (PERL_GET_INTERP->Ibufend)
#define PL_bufptr (PERL_GET_INTERP->Ibufptr)
-#define PL_cddir (PERL_GET_INTERP->Icddir)
#define PL_collation_ix (PERL_GET_INTERP->Icollation_ix)
#define PL_collation_name (PERL_GET_INTERP->Icollation_name)
#define PL_collation_standard (PERL_GET_INTERP->Icollation_standard)
#define PL_curstname (PERL_GET_INTERP->Icurstname)
#define PL_curthr (PERL_GET_INTERP->Icurthr)
#define PL_dbargs (PERL_GET_INTERP->Idbargs)
-#define PL_debdelim (PERL_GET_INTERP->Idebdelim)
-#define PL_debname (PERL_GET_INTERP->Idebname)
#define PL_debstash (PERL_GET_INTERP->Idebstash)
#define PL_debug (PERL_GET_INTERP->Idebug)
#define PL_defgv (PERL_GET_INTERP->Idefgv)
#define PL_diehook (PERL_GET_INTERP->Idiehook)
-#define PL_dlevel (PERL_GET_INTERP->Idlevel)
-#define PL_dlmax (PERL_GET_INTERP->Idlmax)
#define PL_doextract (PERL_GET_INTERP->Idoextract)
#define PL_doswitches (PERL_GET_INTERP->Idoswitches)
#define PL_dowarn (PERL_GET_INTERP->Idowarn)
#define PL_eval_root (PERL_GET_INTERP->Ieval_root)
#define PL_eval_start (PERL_GET_INTERP->Ieval_start)
#define PL_evalseq (PERL_GET_INTERP->Ievalseq)
+#define PL_exit_flags (PERL_GET_INTERP->Iexit_flags)
#define PL_exitlist (PERL_GET_INTERP->Iexitlist)
#define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen)
#define PL_expect (PERL_GET_INTERP->Iexpect)
#define PL_fdpid (PERL_GET_INTERP->Ifdpid)
#define PL_filemode (PERL_GET_INTERP->Ifilemode)
-#define PL_filter_debug (PERL_GET_INTERP->Ifilter_debug)
#define PL_forkprocess (PERL_GET_INTERP->Iforkprocess)
#define PL_formfeed (PERL_GET_INTERP->Iformfeed)
#define PL_generation (PERL_GET_INTERP->Igeneration)
#define PL_last_swash_tmps (PERL_GET_INTERP->Ilast_swash_tmps)
#define PL_last_uni (PERL_GET_INTERP->Ilast_uni)
#define PL_lastfd (PERL_GET_INTERP->Ilastfd)
-#define PL_lastsize (PERL_GET_INTERP->Ilastsize)
-#define PL_lastspbase (PERL_GET_INTERP->Ilastspbase)
#define PL_laststatval (PERL_GET_INTERP->Ilaststatval)
#define PL_laststype (PERL_GET_INTERP->Ilaststype)
-#define PL_leftgv (PERL_GET_INTERP->Ileftgv)
#define PL_lex_brackets (PERL_GET_INTERP->Ilex_brackets)
#define PL_lex_brackstack (PERL_GET_INTERP->Ilex_brackstack)
#define PL_lex_casemods (PERL_GET_INTERP->Ilex_casemods)
#define PL_lex_defer (PERL_GET_INTERP->Ilex_defer)
#define PL_lex_dojoin (PERL_GET_INTERP->Ilex_dojoin)
#define PL_lex_expect (PERL_GET_INTERP->Ilex_expect)
-#define PL_lex_fakebrack (PERL_GET_INTERP->Ilex_fakebrack)
#define PL_lex_formbrack (PERL_GET_INTERP->Ilex_formbrack)
#define PL_lex_inpat (PERL_GET_INTERP->Ilex_inpat)
#define PL_lex_inwhat (PERL_GET_INTERP->Ilex_inwhat)
#define PL_multi_open (PERL_GET_INTERP->Imulti_open)
#define PL_multi_start (PERL_GET_INTERP->Imulti_start)
#define PL_multiline (PERL_GET_INTERP->Imultiline)
-#define PL_mystrk (PERL_GET_INTERP->Imystrk)
#define PL_nexttoke (PERL_GET_INTERP->Inexttoke)
#define PL_nexttype (PERL_GET_INTERP->Inexttype)
#define PL_nextval (PERL_GET_INTERP->Inextval)
#define PL_numeric_standard (PERL_GET_INTERP->Inumeric_standard)
#define PL_ofmt (PERL_GET_INTERP->Iofmt)
#define PL_oldbufptr (PERL_GET_INTERP->Ioldbufptr)
-#define PL_oldlastpm (PERL_GET_INTERP->Ioldlastpm)
#define PL_oldname (PERL_GET_INTERP->Ioldname)
#define PL_oldoldbufptr (PERL_GET_INTERP->Ioldoldbufptr)
#define PL_op_mask (PERL_GET_INTERP->Iop_mask)
#define PL_preambled (PERL_GET_INTERP->Ipreambled)
#define PL_preprocess (PERL_GET_INTERP->Ipreprocess)
#define PL_profiledata (PERL_GET_INTERP->Iprofiledata)
+#define PL_psig_name (PERL_GET_INTERP->Ipsig_name)
+#define PL_psig_ptr (PERL_GET_INTERP->Ipsig_ptr)
+#define PL_ptr_table (PERL_GET_INTERP->Iptr_table)
#define PL_replgv (PERL_GET_INTERP->Ireplgv)
-#define PL_rightgv (PERL_GET_INTERP->Irightgv)
#define PL_rsfp (PERL_GET_INTERP->Irsfp)
#define PL_rsfp_filters (PERL_GET_INTERP->Irsfp_filters)
#define PL_runops (PERL_GET_INTERP->Irunops)
#define PL_sawampersand (PERL_GET_INTERP->Isawampersand)
-#define PL_sawstudy (PERL_GET_INTERP->Isawstudy)
-#define PL_sawvec (PERL_GET_INTERP->Isawvec)
#define PL_sh_path (PERL_GET_INTERP->Ish_path)
-#define PL_siggv (PERL_GET_INTERP->Isiggv)
#define PL_sighandlerp (PERL_GET_INTERP->Isighandlerp)
#define PL_splitstr (PERL_GET_INTERP->Isplitstr)
#define PL_srand_called (PERL_GET_INTERP->Isrand_called)
#define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms)
#define PL_stderrgv (PERL_GET_INTERP->Istderrgv)
#define PL_stdingv (PERL_GET_INTERP->Istdingv)
-#define PL_strchop (PERL_GET_INTERP->Istrchop)
+#define PL_stopav (PERL_GET_INTERP->Istopav)
#define PL_strtab (PERL_GET_INTERP->Istrtab)
#define PL_strtab_mutex (PERL_GET_INTERP->Istrtab_mutex)
#define PL_sub_generation (PERL_GET_INTERP->Isub_generation)
#define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex)
#define PL_sys_intern (PERL_GET_INTERP->Isys_intern)
#define PL_tainting (PERL_GET_INTERP->Itainting)
-#define PL_thisexpr (PERL_GET_INTERP->Ithisexpr)
#define PL_thr_key (PERL_GET_INTERP->Ithr_key)
#define PL_threadnum (PERL_GET_INTERP->Ithreadnum)
#define PL_threads_mutex (PERL_GET_INTERP->Ithreads_mutex)
#define PL_Env (vTHX->IEnv)
#define PL_LIO (vTHX->ILIO)
#define PL_Mem (vTHX->IMem)
+#define PL_MemParse (vTHX->IMemParse)
+#define PL_MemShared (vTHX->IMemShared)
#define PL_Proc (vTHX->IProc)
#define PL_Sock (vTHX->ISock)
#define PL_StdIO (vTHX->IStdIO)
#define PL_amagic_generation (vTHX->Iamagic_generation)
-#define PL_ampergv (vTHX->Iampergv)
#define PL_an (vTHX->Ian)
#define PL_archpat_auto (vTHX->Iarchpat_auto)
#define PL_argvgv (vTHX->Iargvgv)
+#define PL_argvout_stack (vTHX->Iargvout_stack)
#define PL_argvoutgv (vTHX->Iargvoutgv)
#define PL_basetime (vTHX->Ibasetime)
#define PL_beginav (vTHX->Ibeginav)
#define PL_bitcount (vTHX->Ibitcount)
#define PL_bufend (vTHX->Ibufend)
#define PL_bufptr (vTHX->Ibufptr)
-#define PL_cddir (vTHX->Icddir)
#define PL_collation_ix (vTHX->Icollation_ix)
#define PL_collation_name (vTHX->Icollation_name)
#define PL_collation_standard (vTHX->Icollation_standard)
#define PL_curstname (vTHX->Icurstname)
#define PL_curthr (vTHX->Icurthr)
#define PL_dbargs (vTHX->Idbargs)
-#define PL_debdelim (vTHX->Idebdelim)
-#define PL_debname (vTHX->Idebname)
#define PL_debstash (vTHX->Idebstash)
#define PL_debug (vTHX->Idebug)
#define PL_defgv (vTHX->Idefgv)
#define PL_diehook (vTHX->Idiehook)
-#define PL_dlevel (vTHX->Idlevel)
-#define PL_dlmax (vTHX->Idlmax)
#define PL_doextract (vTHX->Idoextract)
#define PL_doswitches (vTHX->Idoswitches)
#define PL_dowarn (vTHX->Idowarn)
#define PL_eval_root (vTHX->Ieval_root)
#define PL_eval_start (vTHX->Ieval_start)
#define PL_evalseq (vTHX->Ievalseq)
+#define PL_exit_flags (vTHX->Iexit_flags)
#define PL_exitlist (vTHX->Iexitlist)
#define PL_exitlistlen (vTHX->Iexitlistlen)
#define PL_expect (vTHX->Iexpect)
#define PL_fdpid (vTHX->Ifdpid)
#define PL_filemode (vTHX->Ifilemode)
-#define PL_filter_debug (vTHX->Ifilter_debug)
#define PL_forkprocess (vTHX->Iforkprocess)
#define PL_formfeed (vTHX->Iformfeed)
#define PL_generation (vTHX->Igeneration)
#define PL_last_swash_tmps (vTHX->Ilast_swash_tmps)
#define PL_last_uni (vTHX->Ilast_uni)
#define PL_lastfd (vTHX->Ilastfd)
-#define PL_lastsize (vTHX->Ilastsize)
-#define PL_lastspbase (vTHX->Ilastspbase)
#define PL_laststatval (vTHX->Ilaststatval)
#define PL_laststype (vTHX->Ilaststype)
-#define PL_leftgv (vTHX->Ileftgv)
#define PL_lex_brackets (vTHX->Ilex_brackets)
#define PL_lex_brackstack (vTHX->Ilex_brackstack)
#define PL_lex_casemods (vTHX->Ilex_casemods)
#define PL_lex_defer (vTHX->Ilex_defer)
#define PL_lex_dojoin (vTHX->Ilex_dojoin)
#define PL_lex_expect (vTHX->Ilex_expect)
-#define PL_lex_fakebrack (vTHX->Ilex_fakebrack)
#define PL_lex_formbrack (vTHX->Ilex_formbrack)
#define PL_lex_inpat (vTHX->Ilex_inpat)
#define PL_lex_inwhat (vTHX->Ilex_inwhat)
#define PL_multi_open (vTHX->Imulti_open)
#define PL_multi_start (vTHX->Imulti_start)
#define PL_multiline (vTHX->Imultiline)
-#define PL_mystrk (vTHX->Imystrk)
#define PL_nexttoke (vTHX->Inexttoke)
#define PL_nexttype (vTHX->Inexttype)
#define PL_nextval (vTHX->Inextval)
#define PL_numeric_standard (vTHX->Inumeric_standard)
#define PL_ofmt (vTHX->Iofmt)
#define PL_oldbufptr (vTHX->Ioldbufptr)
-#define PL_oldlastpm (vTHX->Ioldlastpm)
#define PL_oldname (vTHX->Ioldname)
#define PL_oldoldbufptr (vTHX->Ioldoldbufptr)
#define PL_op_mask (vTHX->Iop_mask)
#define PL_preambled (vTHX->Ipreambled)
#define PL_preprocess (vTHX->Ipreprocess)
#define PL_profiledata (vTHX->Iprofiledata)
+#define PL_psig_name (vTHX->Ipsig_name)
+#define PL_psig_ptr (vTHX->Ipsig_ptr)
+#define PL_ptr_table (vTHX->Iptr_table)
#define PL_replgv (vTHX->Ireplgv)
-#define PL_rightgv (vTHX->Irightgv)
#define PL_rsfp (vTHX->Irsfp)
#define PL_rsfp_filters (vTHX->Irsfp_filters)
#define PL_runops (vTHX->Irunops)
#define PL_sawampersand (vTHX->Isawampersand)
-#define PL_sawstudy (vTHX->Isawstudy)
-#define PL_sawvec (vTHX->Isawvec)
#define PL_sh_path (vTHX->Ish_path)
-#define PL_siggv (vTHX->Isiggv)
#define PL_sighandlerp (vTHX->Isighandlerp)
#define PL_splitstr (vTHX->Isplitstr)
#define PL_srand_called (vTHX->Isrand_called)
#define PL_statusvalue_vms (vTHX->Istatusvalue_vms)
#define PL_stderrgv (vTHX->Istderrgv)
#define PL_stdingv (vTHX->Istdingv)
-#define PL_strchop (vTHX->Istrchop)
+#define PL_stopav (vTHX->Istopav)
#define PL_strtab (vTHX->Istrtab)
#define PL_strtab_mutex (vTHX->Istrtab_mutex)
#define PL_sub_generation (vTHX->Isub_generation)
#define PL_svref_mutex (vTHX->Isvref_mutex)
#define PL_sys_intern (vTHX->Isys_intern)
#define PL_tainting (vTHX->Itainting)
-#define PL_thisexpr (vTHX->Ithisexpr)
#define PL_thr_key (vTHX->Ithr_key)
#define PL_threadnum (vTHX->Ithreadnum)
#define PL_threads_mutex (vTHX->Ithreads_mutex)
# endif /* USE_THREADS */
#else /* !MULTIPLICITY */
-/* cases 1, 4 and 6 above */
+
+# if defined(PERL_OBJECT)
+/* case 6 above */
+
+#define PL_Sv (aTHXo->interp.TSv)
+#define PL_Xpv (aTHXo->interp.TXpv)
+#define PL_av_fetch_sv (aTHXo->interp.Tav_fetch_sv)
+#define PL_bodytarget (aTHXo->interp.Tbodytarget)
+#define PL_bostr (aTHXo->interp.Tbostr)
+#define PL_chopset (aTHXo->interp.Tchopset)
+#define PL_colors (aTHXo->interp.Tcolors)
+#define PL_colorset (aTHXo->interp.Tcolorset)
+#define PL_curcop (aTHXo->interp.Tcurcop)
+#define PL_curpad (aTHXo->interp.Tcurpad)
+#define PL_curpm (aTHXo->interp.Tcurpm)
+#define PL_curstack (aTHXo->interp.Tcurstack)
+#define PL_curstackinfo (aTHXo->interp.Tcurstackinfo)
+#define PL_curstash (aTHXo->interp.Tcurstash)
+#define PL_defoutgv (aTHXo->interp.Tdefoutgv)
+#define PL_defstash (aTHXo->interp.Tdefstash)
+#define PL_delaymagic (aTHXo->interp.Tdelaymagic)
+#define PL_dirty (aTHXo->interp.Tdirty)
+#define PL_dumpindent (aTHXo->interp.Tdumpindent)
+#define PL_efloatbuf (aTHXo->interp.Tefloatbuf)
+#define PL_efloatsize (aTHXo->interp.Tefloatsize)
+#define PL_errors (aTHXo->interp.Terrors)
+#define PL_extralen (aTHXo->interp.Textralen)
+#define PL_firstgv (aTHXo->interp.Tfirstgv)
+#define PL_formtarget (aTHXo->interp.Tformtarget)
+#define PL_hv_fetch_ent_mh (aTHXo->interp.Thv_fetch_ent_mh)
+#define PL_hv_fetch_sv (aTHXo->interp.Thv_fetch_sv)
+#define PL_in_eval (aTHXo->interp.Tin_eval)
+#define PL_last_in_gv (aTHXo->interp.Tlast_in_gv)
+#define PL_lastgotoprobe (aTHXo->interp.Tlastgotoprobe)
+#define PL_lastscream (aTHXo->interp.Tlastscream)
+#define PL_localizing (aTHXo->interp.Tlocalizing)
+#define PL_mainstack (aTHXo->interp.Tmainstack)
+#define PL_markstack (aTHXo->interp.Tmarkstack)
+#define PL_markstack_max (aTHXo->interp.Tmarkstack_max)
+#define PL_markstack_ptr (aTHXo->interp.Tmarkstack_ptr)
+#define PL_maxscream (aTHXo->interp.Tmaxscream)
+#define PL_modcount (aTHXo->interp.Tmodcount)
+#define PL_na (aTHXo->interp.Tna)
+#define PL_nrs (aTHXo->interp.Tnrs)
+#define PL_ofs (aTHXo->interp.Tofs)
+#define PL_ofslen (aTHXo->interp.Tofslen)
+#define PL_op (aTHXo->interp.Top)
+#define PL_opsave (aTHXo->interp.Topsave)
+#define PL_protect (aTHXo->interp.Tprotect)
+#define PL_reg_call_cc (aTHXo->interp.Treg_call_cc)
+#define PL_reg_curpm (aTHXo->interp.Treg_curpm)
+#define PL_reg_eval_set (aTHXo->interp.Treg_eval_set)
+#define PL_reg_flags (aTHXo->interp.Treg_flags)
+#define PL_reg_ganch (aTHXo->interp.Treg_ganch)
+#define PL_reg_leftiter (aTHXo->interp.Treg_leftiter)
+#define PL_reg_magic (aTHXo->interp.Treg_magic)
+#define PL_reg_maxiter (aTHXo->interp.Treg_maxiter)
+#define PL_reg_oldcurpm (aTHXo->interp.Treg_oldcurpm)
+#define PL_reg_oldpos (aTHXo->interp.Treg_oldpos)
+#define PL_reg_oldsaved (aTHXo->interp.Treg_oldsaved)
+#define PL_reg_oldsavedlen (aTHXo->interp.Treg_oldsavedlen)
+#define PL_reg_poscache (aTHXo->interp.Treg_poscache)
+#define PL_reg_poscache_size (aTHXo->interp.Treg_poscache_size)
+#define PL_reg_re (aTHXo->interp.Treg_re)
+#define PL_reg_start_tmp (aTHXo->interp.Treg_start_tmp)
+#define PL_reg_start_tmpl (aTHXo->interp.Treg_start_tmpl)
+#define PL_reg_starttry (aTHXo->interp.Treg_starttry)
+#define PL_reg_sv (aTHXo->interp.Treg_sv)
+#define PL_reg_whilem_seen (aTHXo->interp.Treg_whilem_seen)
+#define PL_regbol (aTHXo->interp.Tregbol)
+#define PL_regcc (aTHXo->interp.Tregcc)
+#define PL_regcode (aTHXo->interp.Tregcode)
+#define PL_regcomp_parse (aTHXo->interp.Tregcomp_parse)
+#define PL_regcomp_rx (aTHXo->interp.Tregcomp_rx)
+#define PL_regcompp (aTHXo->interp.Tregcompp)
+#define PL_regdata (aTHXo->interp.Tregdata)
+#define PL_regdummy (aTHXo->interp.Tregdummy)
+#define PL_regendp (aTHXo->interp.Tregendp)
+#define PL_regeol (aTHXo->interp.Tregeol)
+#define PL_regexecp (aTHXo->interp.Tregexecp)
+#define PL_regflags (aTHXo->interp.Tregflags)
+#define PL_regfree (aTHXo->interp.Tregfree)
+#define PL_regindent (aTHXo->interp.Tregindent)
+#define PL_reginput (aTHXo->interp.Treginput)
+#define PL_regint_start (aTHXo->interp.Tregint_start)
+#define PL_regint_string (aTHXo->interp.Tregint_string)
+#define PL_reginterp_cnt (aTHXo->interp.Treginterp_cnt)
+#define PL_reglastparen (aTHXo->interp.Treglastparen)
+#define PL_regnarrate (aTHXo->interp.Tregnarrate)
+#define PL_regnaughty (aTHXo->interp.Tregnaughty)
+#define PL_regnpar (aTHXo->interp.Tregnpar)
+#define PL_regprecomp (aTHXo->interp.Tregprecomp)
+#define PL_regprev (aTHXo->interp.Tregprev)
+#define PL_regprogram (aTHXo->interp.Tregprogram)
+#define PL_regsawback (aTHXo->interp.Tregsawback)
+#define PL_regseen (aTHXo->interp.Tregseen)
+#define PL_regsize (aTHXo->interp.Tregsize)
+#define PL_regstartp (aTHXo->interp.Tregstartp)
+#define PL_regtill (aTHXo->interp.Tregtill)
+#define PL_regxend (aTHXo->interp.Tregxend)
+#define PL_restartop (aTHXo->interp.Trestartop)
+#define PL_retstack (aTHXo->interp.Tretstack)
+#define PL_retstack_ix (aTHXo->interp.Tretstack_ix)
+#define PL_retstack_max (aTHXo->interp.Tretstack_max)
+#define PL_rs (aTHXo->interp.Trs)
+#define PL_savestack (aTHXo->interp.Tsavestack)
+#define PL_savestack_ix (aTHXo->interp.Tsavestack_ix)
+#define PL_savestack_max (aTHXo->interp.Tsavestack_max)
+#define PL_scopestack (aTHXo->interp.Tscopestack)
+#define PL_scopestack_ix (aTHXo->interp.Tscopestack_ix)
+#define PL_scopestack_max (aTHXo->interp.Tscopestack_max)
+#define PL_screamfirst (aTHXo->interp.Tscreamfirst)
+#define PL_screamnext (aTHXo->interp.Tscreamnext)
+#define PL_secondgv (aTHXo->interp.Tsecondgv)
+#define PL_seen_evals (aTHXo->interp.Tseen_evals)
+#define PL_seen_zerolen (aTHXo->interp.Tseen_zerolen)
+#define PL_sortcop (aTHXo->interp.Tsortcop)
+#define PL_sortcxix (aTHXo->interp.Tsortcxix)
+#define PL_sortstash (aTHXo->interp.Tsortstash)
+#define PL_stack_base (aTHXo->interp.Tstack_base)
+#define PL_stack_max (aTHXo->interp.Tstack_max)
+#define PL_stack_sp (aTHXo->interp.Tstack_sp)
+#define PL_start_env (aTHXo->interp.Tstart_env)
+#define PL_statbuf (aTHXo->interp.Tstatbuf)
+#define PL_statcache (aTHXo->interp.Tstatcache)
+#define PL_statgv (aTHXo->interp.Tstatgv)
+#define PL_statname (aTHXo->interp.Tstatname)
+#define PL_tainted (aTHXo->interp.Ttainted)
+#define PL_timesbuf (aTHXo->interp.Ttimesbuf)
+#define PL_tmps_floor (aTHXo->interp.Ttmps_floor)
+#define PL_tmps_ix (aTHXo->interp.Ttmps_ix)
+#define PL_tmps_max (aTHXo->interp.Ttmps_max)
+#define PL_tmps_stack (aTHXo->interp.Ttmps_stack)
+#define PL_top_env (aTHXo->interp.Ttop_env)
+#define PL_toptarget (aTHXo->interp.Ttoptarget)
+#define PL_watchaddr (aTHXo->interp.Twatchaddr)
+#define PL_watchok (aTHXo->interp.Twatchok)
+#define PL_Argv (aTHXo->interp.IArgv)
+#define PL_Cmd (aTHXo->interp.ICmd)
+#define PL_DBcv (aTHXo->interp.IDBcv)
+#define PL_DBgv (aTHXo->interp.IDBgv)
+#define PL_DBline (aTHXo->interp.IDBline)
+#define PL_DBsignal (aTHXo->interp.IDBsignal)
+#define PL_DBsingle (aTHXo->interp.IDBsingle)
+#define PL_DBsub (aTHXo->interp.IDBsub)
+#define PL_DBtrace (aTHXo->interp.IDBtrace)
+#define PL_Dir (aTHXo->interp.IDir)
+#define PL_Env (aTHXo->interp.IEnv)
+#define PL_LIO (aTHXo->interp.ILIO)
+#define PL_Mem (aTHXo->interp.IMem)
+#define PL_MemParse (aTHXo->interp.IMemParse)
+#define PL_MemShared (aTHXo->interp.IMemShared)
+#define PL_Proc (aTHXo->interp.IProc)
+#define PL_Sock (aTHXo->interp.ISock)
+#define PL_StdIO (aTHXo->interp.IStdIO)
+#define PL_amagic_generation (aTHXo->interp.Iamagic_generation)
+#define PL_an (aTHXo->interp.Ian)
+#define PL_archpat_auto (aTHXo->interp.Iarchpat_auto)
+#define PL_argvgv (aTHXo->interp.Iargvgv)
+#define PL_argvout_stack (aTHXo->interp.Iargvout_stack)
+#define PL_argvoutgv (aTHXo->interp.Iargvoutgv)
+#define PL_basetime (aTHXo->interp.Ibasetime)
+#define PL_beginav (aTHXo->interp.Ibeginav)
+#define PL_bitcount (aTHXo->interp.Ibitcount)
+#define PL_bufend (aTHXo->interp.Ibufend)
+#define PL_bufptr (aTHXo->interp.Ibufptr)
+#define PL_collation_ix (aTHXo->interp.Icollation_ix)
+#define PL_collation_name (aTHXo->interp.Icollation_name)
+#define PL_collation_standard (aTHXo->interp.Icollation_standard)
+#define PL_collxfrm_base (aTHXo->interp.Icollxfrm_base)
+#define PL_collxfrm_mult (aTHXo->interp.Icollxfrm_mult)
+#define PL_compcv (aTHXo->interp.Icompcv)
+#define PL_compiling (aTHXo->interp.Icompiling)
+#define PL_comppad (aTHXo->interp.Icomppad)
+#define PL_comppad_name (aTHXo->interp.Icomppad_name)
+#define PL_comppad_name_fill (aTHXo->interp.Icomppad_name_fill)
+#define PL_comppad_name_floor (aTHXo->interp.Icomppad_name_floor)
+#define PL_cop_seqmax (aTHXo->interp.Icop_seqmax)
+#define PL_copline (aTHXo->interp.Icopline)
+#define PL_cred_mutex (aTHXo->interp.Icred_mutex)
+#define PL_cryptseen (aTHXo->interp.Icryptseen)
+#define PL_cshlen (aTHXo->interp.Icshlen)
+#define PL_cshname (aTHXo->interp.Icshname)
+#define PL_curcopdb (aTHXo->interp.Icurcopdb)
+#define PL_curstname (aTHXo->interp.Icurstname)
+#define PL_curthr (aTHXo->interp.Icurthr)
+#define PL_dbargs (aTHXo->interp.Idbargs)
+#define PL_debstash (aTHXo->interp.Idebstash)
+#define PL_debug (aTHXo->interp.Idebug)
+#define PL_defgv (aTHXo->interp.Idefgv)
+#define PL_diehook (aTHXo->interp.Idiehook)
+#define PL_doextract (aTHXo->interp.Idoextract)
+#define PL_doswitches (aTHXo->interp.Idoswitches)
+#define PL_dowarn (aTHXo->interp.Idowarn)
+#define PL_e_script (aTHXo->interp.Ie_script)
+#define PL_egid (aTHXo->interp.Iegid)
+#define PL_endav (aTHXo->interp.Iendav)
+#define PL_envgv (aTHXo->interp.Ienvgv)
+#define PL_errgv (aTHXo->interp.Ierrgv)
+#define PL_error_count (aTHXo->interp.Ierror_count)
+#define PL_euid (aTHXo->interp.Ieuid)
+#define PL_eval_cond (aTHXo->interp.Ieval_cond)
+#define PL_eval_mutex (aTHXo->interp.Ieval_mutex)
+#define PL_eval_owner (aTHXo->interp.Ieval_owner)
+#define PL_eval_root (aTHXo->interp.Ieval_root)
+#define PL_eval_start (aTHXo->interp.Ieval_start)
+#define PL_evalseq (aTHXo->interp.Ievalseq)
+#define PL_exit_flags (aTHXo->interp.Iexit_flags)
+#define PL_exitlist (aTHXo->interp.Iexitlist)
+#define PL_exitlistlen (aTHXo->interp.Iexitlistlen)
+#define PL_expect (aTHXo->interp.Iexpect)
+#define PL_fdpid (aTHXo->interp.Ifdpid)
+#define PL_filemode (aTHXo->interp.Ifilemode)
+#define PL_forkprocess (aTHXo->interp.Iforkprocess)
+#define PL_formfeed (aTHXo->interp.Iformfeed)
+#define PL_generation (aTHXo->interp.Igeneration)
+#define PL_gensym (aTHXo->interp.Igensym)
+#define PL_gid (aTHXo->interp.Igid)
+#define PL_glob_index (aTHXo->interp.Iglob_index)
+#define PL_globalstash (aTHXo->interp.Iglobalstash)
+#define PL_he_root (aTHXo->interp.Ihe_root)
+#define PL_hintgv (aTHXo->interp.Ihintgv)
+#define PL_hints (aTHXo->interp.Ihints)
+#define PL_in_clean_all (aTHXo->interp.Iin_clean_all)
+#define PL_in_clean_objs (aTHXo->interp.Iin_clean_objs)
+#define PL_in_my (aTHXo->interp.Iin_my)
+#define PL_in_my_stash (aTHXo->interp.Iin_my_stash)
+#define PL_incgv (aTHXo->interp.Iincgv)
+#define PL_initav (aTHXo->interp.Iinitav)
+#define PL_inplace (aTHXo->interp.Iinplace)
+#define PL_last_lop (aTHXo->interp.Ilast_lop)
+#define PL_last_lop_op (aTHXo->interp.Ilast_lop_op)
+#define PL_last_swash_hv (aTHXo->interp.Ilast_swash_hv)
+#define PL_last_swash_key (aTHXo->interp.Ilast_swash_key)
+#define PL_last_swash_klen (aTHXo->interp.Ilast_swash_klen)
+#define PL_last_swash_slen (aTHXo->interp.Ilast_swash_slen)
+#define PL_last_swash_tmps (aTHXo->interp.Ilast_swash_tmps)
+#define PL_last_uni (aTHXo->interp.Ilast_uni)
+#define PL_lastfd (aTHXo->interp.Ilastfd)
+#define PL_laststatval (aTHXo->interp.Ilaststatval)
+#define PL_laststype (aTHXo->interp.Ilaststype)
+#define PL_lex_brackets (aTHXo->interp.Ilex_brackets)
+#define PL_lex_brackstack (aTHXo->interp.Ilex_brackstack)
+#define PL_lex_casemods (aTHXo->interp.Ilex_casemods)
+#define PL_lex_casestack (aTHXo->interp.Ilex_casestack)
+#define PL_lex_defer (aTHXo->interp.Ilex_defer)
+#define PL_lex_dojoin (aTHXo->interp.Ilex_dojoin)
+#define PL_lex_expect (aTHXo->interp.Ilex_expect)
+#define PL_lex_formbrack (aTHXo->interp.Ilex_formbrack)
+#define PL_lex_inpat (aTHXo->interp.Ilex_inpat)
+#define PL_lex_inwhat (aTHXo->interp.Ilex_inwhat)
+#define PL_lex_op (aTHXo->interp.Ilex_op)
+#define PL_lex_repl (aTHXo->interp.Ilex_repl)
+#define PL_lex_starts (aTHXo->interp.Ilex_starts)
+#define PL_lex_state (aTHXo->interp.Ilex_state)
+#define PL_lex_stuff (aTHXo->interp.Ilex_stuff)
+#define PL_lineary (aTHXo->interp.Ilineary)
+#define PL_linestart (aTHXo->interp.Ilinestart)
+#define PL_linestr (aTHXo->interp.Ilinestr)
+#define PL_localpatches (aTHXo->interp.Ilocalpatches)
+#define PL_main_cv (aTHXo->interp.Imain_cv)
+#define PL_main_root (aTHXo->interp.Imain_root)
+#define PL_main_start (aTHXo->interp.Imain_start)
+#define PL_max_intro_pending (aTHXo->interp.Imax_intro_pending)
+#define PL_maxo (aTHXo->interp.Imaxo)
+#define PL_maxsysfd (aTHXo->interp.Imaxsysfd)
+#define PL_mess_sv (aTHXo->interp.Imess_sv)
+#define PL_min_intro_pending (aTHXo->interp.Imin_intro_pending)
+#define PL_minus_F (aTHXo->interp.Iminus_F)
+#define PL_minus_a (aTHXo->interp.Iminus_a)
+#define PL_minus_c (aTHXo->interp.Iminus_c)
+#define PL_minus_l (aTHXo->interp.Iminus_l)
+#define PL_minus_n (aTHXo->interp.Iminus_n)
+#define PL_minus_p (aTHXo->interp.Iminus_p)
+#define PL_modglobal (aTHXo->interp.Imodglobal)
+#define PL_multi_close (aTHXo->interp.Imulti_close)
+#define PL_multi_end (aTHXo->interp.Imulti_end)
+#define PL_multi_open (aTHXo->interp.Imulti_open)
+#define PL_multi_start (aTHXo->interp.Imulti_start)
+#define PL_multiline (aTHXo->interp.Imultiline)
+#define PL_nexttoke (aTHXo->interp.Inexttoke)
+#define PL_nexttype (aTHXo->interp.Inexttype)
+#define PL_nextval (aTHXo->interp.Inextval)
+#define PL_nice_chunk (aTHXo->interp.Inice_chunk)
+#define PL_nice_chunk_size (aTHXo->interp.Inice_chunk_size)
+#define PL_nomemok (aTHXo->interp.Inomemok)
+#define PL_nthreads (aTHXo->interp.Inthreads)
+#define PL_nthreads_cond (aTHXo->interp.Inthreads_cond)
+#define PL_numeric_local (aTHXo->interp.Inumeric_local)
+#define PL_numeric_name (aTHXo->interp.Inumeric_name)
+#define PL_numeric_radix (aTHXo->interp.Inumeric_radix)
+#define PL_numeric_standard (aTHXo->interp.Inumeric_standard)
+#define PL_ofmt (aTHXo->interp.Iofmt)
+#define PL_oldbufptr (aTHXo->interp.Ioldbufptr)
+#define PL_oldname (aTHXo->interp.Ioldname)
+#define PL_oldoldbufptr (aTHXo->interp.Ioldoldbufptr)
+#define PL_op_mask (aTHXo->interp.Iop_mask)
+#define PL_op_seqmax (aTHXo->interp.Iop_seqmax)
+#define PL_origalen (aTHXo->interp.Iorigalen)
+#define PL_origargc (aTHXo->interp.Iorigargc)
+#define PL_origargv (aTHXo->interp.Iorigargv)
+#define PL_origenviron (aTHXo->interp.Iorigenviron)
+#define PL_origfilename (aTHXo->interp.Iorigfilename)
+#define PL_ors (aTHXo->interp.Iors)
+#define PL_orslen (aTHXo->interp.Iorslen)
+#define PL_osname (aTHXo->interp.Iosname)
+#define PL_pad_reset_pending (aTHXo->interp.Ipad_reset_pending)
+#define PL_padix (aTHXo->interp.Ipadix)
+#define PL_padix_floor (aTHXo->interp.Ipadix_floor)
+#define PL_patchlevel (aTHXo->interp.Ipatchlevel)
+#define PL_pending_ident (aTHXo->interp.Ipending_ident)
+#define PL_perl_destruct_level (aTHXo->interp.Iperl_destruct_level)
+#define PL_perldb (aTHXo->interp.Iperldb)
+#define PL_pidstatus (aTHXo->interp.Ipidstatus)
+#define PL_preambleav (aTHXo->interp.Ipreambleav)
+#define PL_preambled (aTHXo->interp.Ipreambled)
+#define PL_preprocess (aTHXo->interp.Ipreprocess)
+#define PL_profiledata (aTHXo->interp.Iprofiledata)
+#define PL_psig_name (aTHXo->interp.Ipsig_name)
+#define PL_psig_ptr (aTHXo->interp.Ipsig_ptr)
+#define PL_ptr_table (aTHXo->interp.Iptr_table)
+#define PL_replgv (aTHXo->interp.Ireplgv)
+#define PL_rsfp (aTHXo->interp.Irsfp)
+#define PL_rsfp_filters (aTHXo->interp.Irsfp_filters)
+#define PL_runops (aTHXo->interp.Irunops)
+#define PL_sawampersand (aTHXo->interp.Isawampersand)
+#define PL_sh_path (aTHXo->interp.Ish_path)
+#define PL_sighandlerp (aTHXo->interp.Isighandlerp)
+#define PL_splitstr (aTHXo->interp.Isplitstr)
+#define PL_srand_called (aTHXo->interp.Isrand_called)
+#define PL_statusvalue (aTHXo->interp.Istatusvalue)
+#define PL_statusvalue_vms (aTHXo->interp.Istatusvalue_vms)
+#define PL_stderrgv (aTHXo->interp.Istderrgv)
+#define PL_stdingv (aTHXo->interp.Istdingv)
+#define PL_stopav (aTHXo->interp.Istopav)
+#define PL_strtab (aTHXo->interp.Istrtab)
+#define PL_strtab_mutex (aTHXo->interp.Istrtab_mutex)
+#define PL_sub_generation (aTHXo->interp.Isub_generation)
+#define PL_sublex_info (aTHXo->interp.Isublex_info)
+#define PL_subline (aTHXo->interp.Isubline)
+#define PL_subname (aTHXo->interp.Isubname)
+#define PL_sv_arenaroot (aTHXo->interp.Isv_arenaroot)
+#define PL_sv_count (aTHXo->interp.Isv_count)
+#define PL_sv_mutex (aTHXo->interp.Isv_mutex)
+#define PL_sv_no (aTHXo->interp.Isv_no)
+#define PL_sv_objcount (aTHXo->interp.Isv_objcount)
+#define PL_sv_root (aTHXo->interp.Isv_root)
+#define PL_sv_undef (aTHXo->interp.Isv_undef)
+#define PL_sv_yes (aTHXo->interp.Isv_yes)
+#define PL_svref_mutex (aTHXo->interp.Isvref_mutex)
+#define PL_sys_intern (aTHXo->interp.Isys_intern)
+#define PL_tainting (aTHXo->interp.Itainting)
+#define PL_thr_key (aTHXo->interp.Ithr_key)
+#define PL_threadnum (aTHXo->interp.Ithreadnum)
+#define PL_threads_mutex (aTHXo->interp.Ithreads_mutex)
+#define PL_threadsv_names (aTHXo->interp.Ithreadsv_names)
+#define PL_thrsv (aTHXo->interp.Ithrsv)
+#define PL_tokenbuf (aTHXo->interp.Itokenbuf)
+#define PL_uid (aTHXo->interp.Iuid)
+#define PL_unsafe (aTHXo->interp.Iunsafe)
+#define PL_utf8_alnum (aTHXo->interp.Iutf8_alnum)
+#define PL_utf8_alnumc (aTHXo->interp.Iutf8_alnumc)
+#define PL_utf8_alpha (aTHXo->interp.Iutf8_alpha)
+#define PL_utf8_ascii (aTHXo->interp.Iutf8_ascii)
+#define PL_utf8_cntrl (aTHXo->interp.Iutf8_cntrl)
+#define PL_utf8_digit (aTHXo->interp.Iutf8_digit)
+#define PL_utf8_graph (aTHXo->interp.Iutf8_graph)
+#define PL_utf8_lower (aTHXo->interp.Iutf8_lower)
+#define PL_utf8_mark (aTHXo->interp.Iutf8_mark)
+#define PL_utf8_print (aTHXo->interp.Iutf8_print)
+#define PL_utf8_punct (aTHXo->interp.Iutf8_punct)
+#define PL_utf8_space (aTHXo->interp.Iutf8_space)
+#define PL_utf8_tolower (aTHXo->interp.Iutf8_tolower)
+#define PL_utf8_totitle (aTHXo->interp.Iutf8_totitle)
+#define PL_utf8_toupper (aTHXo->interp.Iutf8_toupper)
+#define PL_utf8_upper (aTHXo->interp.Iutf8_upper)
+#define PL_utf8_xdigit (aTHXo->interp.Iutf8_xdigit)
+#define PL_uudmap (aTHXo->interp.Iuudmap)
+#define PL_warnhook (aTHXo->interp.Iwarnhook)
+#define PL_xiv_arenaroot (aTHXo->interp.Ixiv_arenaroot)
+#define PL_xiv_root (aTHXo->interp.Ixiv_root)
+#define PL_xnv_root (aTHXo->interp.Ixnv_root)
+#define PL_xpv_root (aTHXo->interp.Ixpv_root)
+#define PL_xpvav_root (aTHXo->interp.Ixpvav_root)
+#define PL_xpvbm_root (aTHXo->interp.Ixpvbm_root)
+#define PL_xpvcv_root (aTHXo->interp.Ixpvcv_root)
+#define PL_xpvhv_root (aTHXo->interp.Ixpvhv_root)
+#define PL_xpviv_root (aTHXo->interp.Ixpviv_root)
+#define PL_xpvlv_root (aTHXo->interp.Ixpvlv_root)
+#define PL_xpvmg_root (aTHXo->interp.Ixpvmg_root)
+#define PL_xpvnv_root (aTHXo->interp.Ixpvnv_root)
+#define PL_xrv_root (aTHXo->interp.Ixrv_root)
+#define PL_yychar (aTHXo->interp.Iyychar)
+#define PL_yydebug (aTHXo->interp.Iyydebug)
+#define PL_yyerrflag (aTHXo->interp.Iyyerrflag)
+#define PL_yylval (aTHXo->interp.Iyylval)
+#define PL_yynerrs (aTHXo->interp.Iyynerrs)
+#define PL_yyval (aTHXo->interp.Iyyval)
+
+# else /* !PERL_OBJECT */
+
+/* cases 1 and 4 above */
#define PL_IArgv PL_Argv
#define PL_ICmd PL_Cmd
#define PL_IEnv PL_Env
#define PL_ILIO PL_LIO
#define PL_IMem PL_Mem
+#define PL_IMemParse PL_MemParse
+#define PL_IMemShared PL_MemShared
#define PL_IProc PL_Proc
#define PL_ISock PL_Sock
#define PL_IStdIO PL_StdIO
#define PL_Iamagic_generation PL_amagic_generation
-#define PL_Iampergv PL_ampergv
#define PL_Ian PL_an
#define PL_Iarchpat_auto PL_archpat_auto
#define PL_Iargvgv PL_argvgv
+#define PL_Iargvout_stack PL_argvout_stack
#define PL_Iargvoutgv PL_argvoutgv
#define PL_Ibasetime PL_basetime
#define PL_Ibeginav PL_beginav
#define PL_Ibitcount PL_bitcount
#define PL_Ibufend PL_bufend
#define PL_Ibufptr PL_bufptr
-#define PL_Icddir PL_cddir
#define PL_Icollation_ix PL_collation_ix
#define PL_Icollation_name PL_collation_name
#define PL_Icollation_standard PL_collation_standard
#define PL_Icurstname PL_curstname
#define PL_Icurthr PL_curthr
#define PL_Idbargs PL_dbargs
-#define PL_Idebdelim PL_debdelim
-#define PL_Idebname PL_debname
#define PL_Idebstash PL_debstash
#define PL_Idebug PL_debug
#define PL_Idefgv PL_defgv
#define PL_Idiehook PL_diehook
-#define PL_Idlevel PL_dlevel
-#define PL_Idlmax PL_dlmax
#define PL_Idoextract PL_doextract
#define PL_Idoswitches PL_doswitches
#define PL_Idowarn PL_dowarn
#define PL_Ieval_root PL_eval_root
#define PL_Ieval_start PL_eval_start
#define PL_Ievalseq PL_evalseq
+#define PL_Iexit_flags PL_exit_flags
#define PL_Iexitlist PL_exitlist
#define PL_Iexitlistlen PL_exitlistlen
#define PL_Iexpect PL_expect
#define PL_Ifdpid PL_fdpid
#define PL_Ifilemode PL_filemode
-#define PL_Ifilter_debug PL_filter_debug
#define PL_Iforkprocess PL_forkprocess
#define PL_Iformfeed PL_formfeed
#define PL_Igeneration PL_generation
#define PL_Ilast_swash_tmps PL_last_swash_tmps
#define PL_Ilast_uni PL_last_uni
#define PL_Ilastfd PL_lastfd
-#define PL_Ilastsize PL_lastsize
-#define PL_Ilastspbase PL_lastspbase
#define PL_Ilaststatval PL_laststatval
#define PL_Ilaststype PL_laststype
-#define PL_Ileftgv PL_leftgv
#define PL_Ilex_brackets PL_lex_brackets
#define PL_Ilex_brackstack PL_lex_brackstack
#define PL_Ilex_casemods PL_lex_casemods
#define PL_Ilex_defer PL_lex_defer
#define PL_Ilex_dojoin PL_lex_dojoin
#define PL_Ilex_expect PL_lex_expect
-#define PL_Ilex_fakebrack PL_lex_fakebrack
#define PL_Ilex_formbrack PL_lex_formbrack
#define PL_Ilex_inpat PL_lex_inpat
#define PL_Ilex_inwhat PL_lex_inwhat
#define PL_Imulti_open PL_multi_open
#define PL_Imulti_start PL_multi_start
#define PL_Imultiline PL_multiline
-#define PL_Imystrk PL_mystrk
#define PL_Inexttoke PL_nexttoke
#define PL_Inexttype PL_nexttype
#define PL_Inextval PL_nextval
#define PL_Inumeric_standard PL_numeric_standard
#define PL_Iofmt PL_ofmt
#define PL_Ioldbufptr PL_oldbufptr
-#define PL_Ioldlastpm PL_oldlastpm
#define PL_Ioldname PL_oldname
#define PL_Ioldoldbufptr PL_oldoldbufptr
#define PL_Iop_mask PL_op_mask
#define PL_Ipreambled PL_preambled
#define PL_Ipreprocess PL_preprocess
#define PL_Iprofiledata PL_profiledata
+#define PL_Ipsig_name PL_psig_name
+#define PL_Ipsig_ptr PL_psig_ptr
+#define PL_Iptr_table PL_ptr_table
#define PL_Ireplgv PL_replgv
-#define PL_Irightgv PL_rightgv
#define PL_Irsfp PL_rsfp
#define PL_Irsfp_filters PL_rsfp_filters
#define PL_Irunops PL_runops
#define PL_Isawampersand PL_sawampersand
-#define PL_Isawstudy PL_sawstudy
-#define PL_Isawvec PL_sawvec
#define PL_Ish_path PL_sh_path
-#define PL_Isiggv PL_siggv
#define PL_Isighandlerp PL_sighandlerp
#define PL_Isplitstr PL_splitstr
#define PL_Isrand_called PL_srand_called
#define PL_Istatusvalue_vms PL_statusvalue_vms
#define PL_Istderrgv PL_stderrgv
#define PL_Istdingv PL_stdingv
-#define PL_Istrchop PL_strchop
+#define PL_Istopav PL_stopav
#define PL_Istrtab PL_strtab
#define PL_Istrtab_mutex PL_strtab_mutex
#define PL_Isub_generation PL_sub_generation
#define PL_Isvref_mutex PL_svref_mutex
#define PL_Isys_intern PL_sys_intern
#define PL_Itainting PL_tainting
-#define PL_Ithisexpr PL_thisexpr
#define PL_Ithr_key PL_thr_key
#define PL_Ithreadnum PL_threadnum
#define PL_Ithreads_mutex PL_threads_mutex
#define PL_Iyynerrs PL_yynerrs
#define PL_Iyyval PL_yyval
-# if defined(USE_THREADS)
+# if defined(USE_THREADS)
/* case 4 above */
#define PL_Sv (aTHX->TSv)
#define PL_watchaddr (aTHX->Twatchaddr)
#define PL_watchok (aTHX->Twatchok)
-# else /* !USE_THREADS */
-/* cases 1 and 6 above */
+# else /* !USE_THREADS */
+/* case 1 above */
#define PL_TSv PL_Sv
#define PL_TXpv PL_Xpv
#define PL_Twatchaddr PL_watchaddr
#define PL_Twatchok PL_watchok
-# endif /* USE_THREADS */
+# endif /* USE_THREADS */
+# endif /* PERL_OBJECT */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
--- /dev/null
+package Config;
+
+use Exporter ();
+@ISA = (Exporter);
+@EXPORT = qw(%Config);
+1;
--- /dev/null
+use AutoSplit;
+mkdir "/perl/lib/5.00562/auto", 0777;
+autosplit("/perl/lib/5.00562/Getopt/Long.pm","/perl/lib/5.00562/auto", 1, 0, 0);
*/
#define HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-/*#define HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-/*#define HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-/*#define HAS_MMAP /**/
-#define Mmap_t void * /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#define HAS_SOCKET /**/
/*#define HAS_SOCKETPAIR /**/
/*#define HAS_MSG_CTRUNC /**/
/*#define HAS_MSG_PEEK /**/
/*#define HAS_MSG_PROXY / **/
/*#define HAS_SCM_RIGHTS /**/
-/*##define HAS_SENDMSG /**/
-/*##define HAS_RECVMSG /**/
-/*##define HAS_STRUCT_MSGHDR /**/
-/*##define HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
/*#define PWGECOS /**/
/*#define PWPASSWD /**/
-/* I_SYSUIO:
- * This symbol, if defined, indicates that <sys/uio.h> exists and
- * should be included.
- */
-#/*define I_SYSUIO /**/
-
/* Free_t:
* This variable contains the return type of free(). It is usually
* void, but occasionally int.
*/
/*#define HAS_HASMNTOPT / **/
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-/*#define HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-/*#define HAS_READV /**/
-
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
*/
#define HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
- */
-/*#define HAS_WRITEV /**/
-
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
* some sort is available.
*/
/*#define I_POLL /**/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-/*#define I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
--- /dev/null
+#!/usr/bin/perl
+
+use File::Find;
+use Cwd;
+
+$VERSION="5.005";
+$PATCH=62;
+$EPOC_VERSION=11;
+$CROSSCOMPILEPATH="Y:";
+
+
+sub filefound {
+ my $f = $File::Find::name;
+
+ return if ( $f =~ /ExtUtils|unicode|CGI|CPAN|Net|IPC|User|DB.pm/i);
+ my $back = $f;
+
+ $back =~ s|$CROSSCOMPILEPATH||;
+
+ $back =~ s|/|\\|g;
+
+ my $psiback = $back;
+
+ $psiback =~ s/\\perl$VERSION\\perl$VERSION\_$PATCH\\lib\\/\\perl\\lib\\$VERSION$PATCH\\/i;
+
+ print OUT "\"$back\"-\"!:$psiback\"\n" if ( -f $f );
+;
+}
+
+
+
+
+
+open OUT,">perl.pkg";
+
+print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n";
+
+print OUT "\"\\epoc32\\release\\marm\\rel\\perl.exe\"-\"!:\\perl.exe\"\n";
+print OUT "\"\\perl$VERSION\\perl${VERSION}_$PATCH\\epoc\\Config.pm\"-\"!:\\perl\\lib\\$VERSION$PATCH\\Config.pm\"\n";
+
+find(\&filefound, cwd.'/lib');
+
+print OUT "@\"\\epoc32\\release\\marm\\rel\\stdlib.sis\",(0x010002c3)\n"
+
+
--- /dev/null
+/*
+ * Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
+
+int getgid() {return 0;}
+int getegid() {return 0;}
+int geteuid() {return 0;}
+int getuid() {return 0;}
+int setgid() {return -1;}
+int setuid() {return -1;}
+
+int Perl_my_popen( int a, int b) {
+ return 0;
+}
+int Perl_my_pclose( int a) {
+ return 0;
+}
+
+kill() {}
+signal() {}
+
+void execv() {}
+void execvp() {}
+void do_spawn() {}
+void do_aspawn() {}
+void Perl_do_exec() {}
+
/* #define ALTERNATE_SHEBANG "#!" / **/
-#ifndef SIGABRT
-# define SIGABRT SIGILL
-#endif
-#ifndef SIGILL
-# define SIGILL 6 /* blech */
-#endif
#define ABORT() abort();
/*
uid 0x100051d8
project perl5.005
-subproject perl5.005_60
+subproject perl5.005_62
-SOURCE av.c deb.c doio.c doop.c dump.c globals.c gv.c hv.c mg.c miniperlmain.c op.c perl.c perlio.c perly.c pp.c pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c sv.c taint.c toke.c universal.c utf8.c util.c epoc.c epoc_stubs.c
+SOURCE av.c deb.c doio.c doop.c dump.c globals.c gv.c hv.c mg.c miniperlmain.c op.c perl.c perlapi.c perlio.c perly.c pp.c pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c sv.c taint.c toke.c universal.c utf8.c util.c xsutils.c epoc.c epoc_stubs.c
systeminclude \epoc32\include\libc \epoc32\include
#if defined(MARM)
-#{"perl5.005"},(0x100051d8),60,10,0
+#{"perl5.005"},(0x100051d8),62,11,0
"\epoc32\release\marm\rel\perl.exe"-"!:\perl.exe"
-"\perl5.005\perl5.005_60\epoc\Config.pm"-"!:\perl\lib\5.00560\Config.pm"
-"\perl5.005\perl5.005_60\lib\AnyDBM_File.pm"-"!:\perl\lib\5.00560\AnyDBM_File.pm"
-"\perl5.005\perl5.005_60\lib\AutoLoader.pm"-"!:\perl\lib\5.00560\AutoLoader.pm"
-"\perl5.005\perl5.005_60\lib\AutoSplit.pm"-"!:\perl\lib\5.00560\AutoSplit.pm"
-"\perl5.005\perl5.005_60\lib\Benchmark.pm"-"!:\perl\lib\5.00560\Benchmark.pm"
-"\perl5.005\perl5.005_60\lib\Carp.pm"-"!:\perl\lib\5.00560\Carp.pm"
-"\perl5.005\perl5.005_60\lib\Carp\Heavy.pm"-"!:\perl\lib\5.00560\Carp\Heavy.pm"
-"\perl5.005\perl5.005_60\lib\Class\Struct.pm"-"!:\perl\lib\5.00560\Class\Struct.pm"
-"\perl5.005\perl5.005_60\lib\Cwd.pm"-"!:\perl\lib\5.00560\Cwd.pm"
-"\perl5.005\perl5.005_60\lib\Devel\SelfStubber.pm"-"!:\perl\lib\5.00560\Devel\SelfStubber.pm"
-"\perl5.005\perl5.005_60\lib\DirHandle.pm"-"!:\perl\lib\5.00560\DirHandle.pm"
-"\perl5.005\perl5.005_60\lib\Dumpvalue.pm"-"!:\perl\lib\5.00560\Dumpvalue.pm"
-"\perl5.005\perl5.005_60\lib\English.pm"-"!:\perl\lib\5.00560\English.pm"
-"\perl5.005\perl5.005_60\lib\Env.pm"-"!:\perl\lib\5.00560\Env.pm"
-"\perl5.005\perl5.005_60\lib\Exporter\Heavy.pm"-"!:\perl\lib\5.00560\Exporter\Heavy.pm"
-"\perl5.005\perl5.005_60\lib\Exporter.pm"-"!:\perl\lib\5.00560\Exporter.pm"
-"\perl5.005\perl5.005_60\lib\Fatal.pm"-"!:\perl\lib\5.00560\Fatal.pm"
-"\perl5.005\perl5.005_60\lib\File\Basename.pm"-"!:\perl\lib\5.00560\File\Basename.pm"
-"\perl5.005\perl5.005_60\lib\File\CheckTree.pm"-"!:\perl\lib\5.00560\File\CheckTree.pm"
-"\perl5.005\perl5.005_60\lib\File\Compare.pm"-"!:\perl\lib\5.00560\File\Compare.pm"
-"\perl5.005\perl5.005_60\lib\File\Copy.pm"-"!:\perl\lib\5.00560\File\Copy.pm"
-"\perl5.005\perl5.005_60\lib\File\DosGlob.pm"-"!:\perl\lib\5.00560\File\DosGlob.pm"
-"\perl5.005\perl5.005_60\lib\File\Find.pm"-"!:\perl\lib\5.00560\File\Find.pm"
-"\perl5.005\perl5.005_60\lib\File\Path.pm"-"!:\perl\lib\5.00560\File\Path.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec.pm"-"!:\perl\lib\5.00560\File\Spec.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\Functions.pm"-"!:\perl\lib\5.00560\File\Spec\Functions.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\Mac.pm"-"!:\perl\lib\5.00560\File\Spec\Mac.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\OS2.pm"-"!:\perl\lib\5.00560\File\Spec\OS2.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\Unix.pm"-"!:\perl\lib\5.00560\File\Spec\Unix.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\VMS.pm"-"!:\perl\lib\5.00560\File\Spec\VMS.pm"
-"\perl5.005\perl5.005_60\lib\File\Spec\Win32.pm"-"!:\perl\lib\5.00560\File\Spec\Win32.pm"
-"\perl5.005\perl5.005_60\lib\File\stat.pm"-"!:\perl\lib\5.00560\File\stat.pm"
-"\perl5.005\perl5.005_60\lib\FileCache.pm"-"!:\perl\lib\5.00560\FileCache.pm"
-"\perl5.005\perl5.005_60\lib\FileHandle.pm"-"!:\perl\lib\5.00560\FileHandle.pm"
-"\perl5.005\perl5.005_60\lib\FindBin.pm"-"!:\perl\lib\5.00560\FindBin.pm"
-"\perl5.005\perl5.005_60\lib\Getopt\Long.pm"-"!:\perl\lib\5.00560\Getopt\Long.pm"
-"\perl5.005\perl5.005_60\lib\Getopt\Std.pm"-"!:\perl\lib\5.00560\Getopt\Std.pm"
-"\perl5.005\perl5.005_60\lib\I18N\Collate.pm"-"!:\perl\lib\5.00560\I18N\Collate.pm"
-"\perl5.005\perl5.005_60\lib\Math\BigFloat.pm"-"!:\perl\lib\5.00560\Math\BigFloat.pm"
-"\perl5.005\perl5.005_60\lib\Math\BigInt.pm"-"!:\perl\lib\5.00560\Math\BigInt.pm"
-"\perl5.005\perl5.005_60\lib\Math\Complex.pm"-"!:\perl\lib\5.00560\Math\Complex.pm"
-"\perl5.005\perl5.005_60\lib\Math\Trig.pm"-"!:\perl\lib\5.00560\Math\Trig.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Checker.pm"-"!:\perl\lib\5.00560\Pod\Checker.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Functions.pm"-"!:\perl\lib\5.00560\Pod\Functions.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Html.pm"-"!:\perl\lib\5.00560\Pod\Html.pm"
-"\perl5.005\perl5.005_60\lib\Pod\InputObjects.pm"-"!:\perl\lib\5.00560\Pod\InputObjects.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Parser.pm"-"!:\perl\lib\5.00560\Pod\Parser.pm"
-"\perl5.005\perl5.005_60\lib\Pod\PlainText.pm"-"!:\perl\lib\5.00560\Pod\PlainText.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Select.pm"-"!:\perl\lib\5.00560\Pod\Select.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Text.pm"-"!:\perl\lib\5.00560\Pod\Text.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Text\Color.pm"-"!:\perl\lib\5.00560\Pod\Text\Color.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Text\Termcap.pm"-"!:\perl\lib\5.00560\Pod\Text\Termcap.pm"
-"\perl5.005\perl5.005_60\lib\Pod\Usage.pm"-"!:\perl\lib\5.00560\Pod\Usage.pm"
-"\perl5.005\perl5.005_60\lib\Search\Dict.pm"-"!:\perl\lib\5.00560\Search\Dict.pm"
-"\perl5.005\perl5.005_60\lib\SelectSaver.pm"-"!:\perl\lib\5.00560\SelectSaver.pm"
-"\perl5.005\perl5.005_60\lib\SelfLoader.pm"-"!:\perl\lib\5.00560\SelfLoader.pm"
-"\perl5.005\perl5.005_60\lib\Shell.pm"-"!:\perl\lib\5.00560\Shell.pm"
-"\perl5.005\perl5.005_60\lib\Symbol.pm"-"!:\perl\lib\5.00560\Symbol.pm"
-"\perl5.005\perl5.005_60\lib\Sys\Hostname.pm"-"!:\perl\lib\5.00560\Sys\Hostname.pm"
-"\perl5.005\perl5.005_60\lib\Sys\Syslog.pm"-"!:\perl\lib\5.00560\Sys\Syslog.pm"
-"\perl5.005\perl5.005_60\lib\Term\Cap.pm"-"!:\perl\lib\5.00560\Term\Cap.pm"
-"\perl5.005\perl5.005_60\lib\Term\Complete.pm"-"!:\perl\lib\5.00560\Term\Complete.pm"
-"\perl5.005\perl5.005_60\lib\Term\ReadLine.pm"-"!:\perl\lib\5.00560\Term\ReadLine.pm"
-"\perl5.005\perl5.005_60\lib\Test.pm"-"!:\perl\lib\5.00560\Test.pm"
-"\perl5.005\perl5.005_60\lib\Test\Harness.pm"-"!:\perl\lib\5.00560\Test\Harness.pm"
-"\perl5.005\perl5.005_60\lib\Text\Abbrev.pm"-"!:\perl\lib\5.00560\Text\Abbrev.pm"
-"\perl5.005\perl5.005_60\lib\Text\ParseWords.pm"-"!:\perl\lib\5.00560\Text\ParseWords.pm"
-"\perl5.005\perl5.005_60\lib\Text\Soundex.pm"-"!:\perl\lib\5.00560\Text\Soundex.pm"
-"\perl5.005\perl5.005_60\lib\Text\Tabs.pm"-"!:\perl\lib\5.00560\Text\Tabs.pm"
-"\perl5.005\perl5.005_60\lib\Text\Wrap.pm"-"!:\perl\lib\5.00560\Text\Wrap.pm"
-"\perl5.005\perl5.005_60\lib\Tie\Array.pm"-"!:\perl\lib\5.00560\Tie\Array.pm"
-"\perl5.005\perl5.005_60\lib\Tie\Handle.pm"-"!:\perl\lib\5.00560\Tie\Handle.pm"
-"\perl5.005\perl5.005_60\lib\Tie\Hash.pm"-"!:\perl\lib\5.00560\Tie\Hash.pm"
-"\perl5.005\perl5.005_60\lib\Tie\RefHash.pm"-"!:\perl\lib\5.00560\Tie\RefHash.pm"
-"\perl5.005\perl5.005_60\lib\Tie\Scalar.pm"-"!:\perl\lib\5.00560\Tie\Scalar.pm"
-"\perl5.005\perl5.005_60\lib\Tie\SubstrHash.pm"-"!:\perl\lib\5.00560\Tie\SubstrHash.pm"
-"\perl5.005\perl5.005_60\lib\Time\Local.pm"-"!:\perl\lib\5.00560\Time\Local.pm"
-"\perl5.005\perl5.005_60\lib\Time\gmtime.pm"-"!:\perl\lib\5.00560\Time\gmtime.pm"
-"\perl5.005\perl5.005_60\lib\Time\localtime.pm"-"!:\perl\lib\5.00560\Time\localtime.pm"
-"\perl5.005\perl5.005_60\lib\Time\tm.pm"-"!:\perl\lib\5.00560\Time\tm.pm"
-"\perl5.005\perl5.005_60\lib\UNIVERSAL.pm"-"!:\perl\lib\5.00560\UNIVERSAL.pm"
-"\perl5.005\perl5.005_60\lib\abbrev.pl"-"!:\perl\lib\5.00560\abbrev.pl"
-"\perl5.005\perl5.005_60\lib\assert.pl"-"!:\perl\lib\5.00560\assert.pl"
-"\perl5.005\perl5.005_60\lib\autouse.pm"-"!:\perl\lib\5.00560\autouse.pm"
-"\perl5.005\perl5.005_60\lib\base.pm"-"!:\perl\lib\5.00560\base.pm"
-"\perl5.005\perl5.005_60\lib\bigfloat.pl"-"!:\perl\lib\5.00560\bigfloat.pl"
-"\perl5.005\perl5.005_60\lib\bigint.pl"-"!:\perl\lib\5.00560\bigint.pl"
-"\perl5.005\perl5.005_60\lib\bigrat.pl"-"!:\perl\lib\5.00560\bigrat.pl"
-"\perl5.005\perl5.005_60\lib\blib.pm"-"!:\perl\lib\5.00560\blib.pm"
-"\perl5.005\perl5.005_60\lib\cacheout.pl"-"!:\perl\lib\5.00560\cacheout.pl"
-"\perl5.005\perl5.005_60\lib\caller.pm"-"!:\perl\lib\5.00560\caller.pm"
-"\perl5.005\perl5.005_60\lib\chat2.pl"-"!:\perl\lib\5.00560\chat2.pl"
-"\perl5.005\perl5.005_60\lib\complete.pl"-"!:\perl\lib\5.00560\complete.pl"
-"\perl5.005\perl5.005_60\lib\constant.pm"-"!:\perl\lib\5.00560\constant.pm"
-"\perl5.005\perl5.005_60\lib\ctime.pl"-"!:\perl\lib\5.00560\ctime.pl"
-"\perl5.005\perl5.005_60\lib\diagnostics.pm"-"!:\perl\lib\5.00560\diagnostics.pm"
-"\perl5.005\perl5.005_60\lib\dotsh.pl"-"!:\perl\lib\5.00560\dotsh.pl"
-"\perl5.005\perl5.005_60\lib\dumpvar.pl"-"!:\perl\lib\5.00560\dumpvar.pl"
-"\perl5.005\perl5.005_60\lib\exceptions.pl"-"!:\perl\lib\5.00560\exceptions.pl"
-"\perl5.005\perl5.005_60\lib\fastcwd.pl"-"!:\perl\lib\5.00560\fastcwd.pl"
-"\perl5.005\perl5.005_60\lib\fields.pm"-"!:\perl\lib\5.00560\fields.pm"
-"\perl5.005\perl5.005_60\lib\filetest.pm"-"!:\perl\lib\5.00560\filetest.pm"
-"\perl5.005\perl5.005_60\lib\find.pl"-"!:\perl\lib\5.00560\find.pl"
-"\perl5.005\perl5.005_60\lib\finddepth.pl"-"!:\perl\lib\5.00560\finddepth.pl"
-"\perl5.005\perl5.005_60\lib\flush.pl"-"!:\perl\lib\5.00560\flush.pl"
-"\perl5.005\perl5.005_60\lib\ftp.pl"-"!:\perl\lib\5.00560\ftp.pl"
-"\perl5.005\perl5.005_60\lib\getcwd.pl"-"!:\perl\lib\5.00560\getcwd.pl"
-"\perl5.005\perl5.005_60\lib\getopt.pl"-"!:\perl\lib\5.00560\getopt.pl"
-"\perl5.005\perl5.005_60\lib\getopts.pl"-"!:\perl\lib\5.00560\getopts.pl"
-"\perl5.005\perl5.005_60\lib\hostname.pl"-"!:\perl\lib\5.00560\hostname.pl"
-"\perl5.005\perl5.005_60\lib\importenv.pl"-"!:\perl\lib\5.00560\importenv.pl"
-"\perl5.005\perl5.005_60\lib\integer.pm"-"!:\perl\lib\5.00560\integer.pm"
-"\perl5.005\perl5.005_60\lib\less.pm"-"!:\perl\lib\5.00560\less.pm"
-"\perl5.005\perl5.005_60\lib\lib.pm"-"!:\perl\lib\5.00560\lib.pm"
-"\perl5.005\perl5.005_60\lib\locale.pm"-"!:\perl\lib\5.00560\locale.pm"
-"\perl5.005\perl5.005_60\lib\look.pl"-"!:\perl\lib\5.00560\look.pl"
-"\perl5.005\perl5.005_60\lib\newgetopt.pl"-"!:\perl\lib\5.00560\newgetopt.pl"
-"\perl5.005\perl5.005_60\lib\open2.pl"-"!:\perl\lib\5.00560\open2.pl"
-"\perl5.005\perl5.005_60\lib\open3.pl"-"!:\perl\lib\5.00560\open3.pl"
-"\perl5.005\perl5.005_60\lib\overload.pm"-"!:\perl\lib\5.00560\overload.pm"
-"\perl5.005\perl5.005_60\lib\perl5db.pl"-"!:\perl\lib\5.00560\perl5db.pl"
-"\perl5.005\perl5.005_60\lib\pwd.pl"-"!:\perl\lib\5.00560\pwd.pl"
-"\perl5.005\perl5.005_60\lib\shellwords.pl"-"!:\perl\lib\5.00560\shellwords.pl"
-"\perl5.005\perl5.005_60\lib\sigtrap.pm"-"!:\perl\lib\5.00560\sigtrap.pm"
-"\perl5.005\perl5.005_60\lib\stat.pl"-"!:\perl\lib\5.00560\stat.pl"
-"\perl5.005\perl5.005_60\lib\strict.pm"-"!:\perl\lib\5.00560\strict.pm"
-"\perl5.005\perl5.005_60\lib\subs.pm"-"!:\perl\lib\5.00560\subs.pm"
-"\perl5.005\perl5.005_60\lib\syslog.pl"-"!:\perl\lib\5.00560\syslog.pl"
-"\perl5.005\perl5.005_60\lib\tainted.pl"-"!:\perl\lib\5.00560\tainted.pl"
-"\perl5.005\perl5.005_60\lib\termcap.pl"-"!:\perl\lib\5.00560\termcap.pl"
-"\perl5.005\perl5.005_60\lib\timelocal.pl"-"!:\perl\lib\5.00560\timelocal.pl"
-"\perl5.005\perl5.005_60\lib\utf8.pm"-"!:\perl\lib\5.00560\utf8.pm"
-"\perl5.005\perl5.005_60\lib\utf8_heavy.pl"-"!:\perl\lib\5.00560\utf8_heavy.pl"
-"\perl5.005\perl5.005_60\lib\validate.pl"-"!:\perl\lib\5.00560\validate.pl"
-"\perl5.005\perl5.005_60\lib\vars.pm"-"!:\perl\lib\5.00560\vars.pm"
-"\perl5.005\perl5.005_60\lib\warning.pm"-"!:\perl\lib\5.00560\warning.pm"
+"\perl5.005\perl5.005_62\epoc\Config.pm"-"!:\perl\lib\5.00562\Config.pm"
+"\PERL5.005\perl5.005_62\lib\AnyDBM_File.pm"-"!:\perl\lib\5.00562\AnyDBM_File.pm"
+"\PERL5.005\perl5.005_62\lib\AutoLoader.pm"-"!:\perl\lib\5.00562\AutoLoader.pm"
+"\PERL5.005\perl5.005_62\lib\AutoSplit.pm"-"!:\perl\lib\5.00562\AutoSplit.pm"
+"\PERL5.005\perl5.005_62\lib\Benchmark.pm"-"!:\perl\lib\5.00562\Benchmark.pm"
+"\PERL5.005\perl5.005_62\lib\Carp.pm"-"!:\perl\lib\5.00562\Carp.pm"
+"\PERL5.005\perl5.005_62\lib\Carp\Heavy.pm"-"!:\perl\lib\5.00562\Carp\Heavy.pm"
+"\PERL5.005\perl5.005_62\lib\Class\Struct.pm"-"!:\perl\lib\5.00562\Class\Struct.pm"
+"\PERL5.005\perl5.005_62\lib\Cwd.pm"-"!:\perl\lib\5.00562\Cwd.pm"
+"\PERL5.005\perl5.005_62\lib\Devel\SelfStubber.pm"-"!:\perl\lib\5.00562\Devel\SelfStubber.pm"
+"\PERL5.005\perl5.005_62\lib\DirHandle.pm"-"!:\perl\lib\5.00562\DirHandle.pm"
+"\PERL5.005\perl5.005_62\lib\Dumpvalue.pm"-"!:\perl\lib\5.00562\Dumpvalue.pm"
+"\PERL5.005\perl5.005_62\lib\English.pm"-"!:\perl\lib\5.00562\English.pm"
+"\PERL5.005\perl5.005_62\lib\Env.pm"-"!:\perl\lib\5.00562\Env.pm"
+"\PERL5.005\perl5.005_62\lib\Exporter.pm"-"!:\perl\lib\5.00562\Exporter.pm"
+"\PERL5.005\perl5.005_62\lib\Exporter\Heavy.pm"-"!:\perl\lib\5.00562\Exporter\Heavy.pm"
+"\PERL5.005\perl5.005_62\lib\Fatal.pm"-"!:\perl\lib\5.00562\Fatal.pm"
+"\PERL5.005\perl5.005_62\lib\File\Basename.pm"-"!:\perl\lib\5.00562\File\Basename.pm"
+"\PERL5.005\perl5.005_62\lib\File\CheckTree.pm"-"!:\perl\lib\5.00562\File\CheckTree.pm"
+"\PERL5.005\perl5.005_62\lib\File\Compare.pm"-"!:\perl\lib\5.00562\File\Compare.pm"
+"\PERL5.005\perl5.005_62\lib\File\Copy.pm"-"!:\perl\lib\5.00562\File\Copy.pm"
+"\PERL5.005\perl5.005_62\lib\File\DosGlob.pm"-"!:\perl\lib\5.00562\File\DosGlob.pm"
+"\PERL5.005\perl5.005_62\lib\File\Find.pm"-"!:\perl\lib\5.00562\File\Find.pm"
+"\PERL5.005\perl5.005_62\lib\File\Path.pm"-"!:\perl\lib\5.00562\File\Path.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec.pm"-"!:\perl\lib\5.00562\File\Spec.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\Functions.pm"-"!:\perl\lib\5.00562\File\Spec\Functions.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\Mac.pm"-"!:\perl\lib\5.00562\File\Spec\Mac.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\OS2.pm"-"!:\perl\lib\5.00562\File\Spec\OS2.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\Unix.pm"-"!:\perl\lib\5.00562\File\Spec\Unix.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\VMS.pm"-"!:\perl\lib\5.00562\File\Spec\VMS.pm"
+"\PERL5.005\perl5.005_62\lib\File\Spec\Win32.pm"-"!:\perl\lib\5.00562\File\Spec\Win32.pm"
+"\PERL5.005\perl5.005_62\lib\File\STAT.PM"-"!:\perl\lib\5.00562\File\STAT.PM"
+"\PERL5.005\perl5.005_62\lib\FileCache.pm"-"!:\perl\lib\5.00562\FileCache.pm"
+"\PERL5.005\perl5.005_62\lib\FileHandle.pm"-"!:\perl\lib\5.00562\FileHandle.pm"
+"\PERL5.005\perl5.005_62\lib\FindBin.pm"-"!:\perl\lib\5.00562\FindBin.pm"
+"\PERL5.005\perl5.005_62\lib\Getopt\Long.pm"-"!:\perl\lib\5.00562\Getopt\Long.pm"
+"\PERL5.005\perl5.005_62\lib\Getopt\Std.pm"-"!:\perl\lib\5.00562\Getopt\Std.pm"
+"\PERL5.005\perl5.005_62\lib\I18N\Collate.pm"-"!:\perl\lib\5.00562\I18N\Collate.pm"
+"\PERL5.005\perl5.005_62\lib\Math\BigFloat.pm"-"!:\perl\lib\5.00562\Math\BigFloat.pm"
+"\PERL5.005\perl5.005_62\lib\Math\BigInt.pm"-"!:\perl\lib\5.00562\Math\BigInt.pm"
+"\PERL5.005\perl5.005_62\lib\Math\Complex.pm"-"!:\perl\lib\5.00562\Math\Complex.pm"
+"\PERL5.005\perl5.005_62\lib\Math\Trig.pm"-"!:\perl\lib\5.00562\Math\Trig.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Checker.pm"-"!:\perl\lib\5.00562\Pod\Checker.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Functions.pm"-"!:\perl\lib\5.00562\Pod\Functions.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Html.pm"-"!:\perl\lib\5.00562\Pod\Html.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\InputObjects.pm"-"!:\perl\lib\5.00562\Pod\InputObjects.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Man.pm"-"!:\perl\lib\5.00562\Pod\Man.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Parser.pm"-"!:\perl\lib\5.00562\Pod\Parser.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Select.pm"-"!:\perl\lib\5.00562\Pod\Select.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Text.pm"-"!:\perl\lib\5.00562\Pod\Text.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Text\Color.pm"-"!:\perl\lib\5.00562\Pod\Text\Color.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Text\Termcap.pm"-"!:\perl\lib\5.00562\Pod\Text\Termcap.pm"
+"\PERL5.005\perl5.005_62\lib\Pod\Usage.pm"-"!:\perl\lib\5.00562\Pod\Usage.pm"
+"\PERL5.005\perl5.005_62\lib\Search\Dict.pm"-"!:\perl\lib\5.00562\Search\Dict.pm"
+"\PERL5.005\perl5.005_62\lib\SelectSaver.pm"-"!:\perl\lib\5.00562\SelectSaver.pm"
+"\PERL5.005\perl5.005_62\lib\SelfLoader.pm"-"!:\perl\lib\5.00562\SelfLoader.pm"
+"\PERL5.005\perl5.005_62\lib\Shell.pm"-"!:\perl\lib\5.00562\Shell.pm"
+"\PERL5.005\perl5.005_62\lib\Symbol.pm"-"!:\perl\lib\5.00562\Symbol.pm"
+"\PERL5.005\perl5.005_62\lib\Sys\Hostname.pm"-"!:\perl\lib\5.00562\Sys\Hostname.pm"
+"\PERL5.005\perl5.005_62\lib\Sys\Syslog.pm"-"!:\perl\lib\5.00562\Sys\Syslog.pm"
+"\PERL5.005\perl5.005_62\lib\Term\Cap.pm"-"!:\perl\lib\5.00562\Term\Cap.pm"
+"\PERL5.005\perl5.005_62\lib\Term\Complete.pm"-"!:\perl\lib\5.00562\Term\Complete.pm"
+"\PERL5.005\perl5.005_62\lib\Term\ReadLine.pm"-"!:\perl\lib\5.00562\Term\ReadLine.pm"
+"\PERL5.005\perl5.005_62\lib\Test.pm"-"!:\perl\lib\5.00562\Test.pm"
+"\PERL5.005\perl5.005_62\lib\Test\Harness.pm"-"!:\perl\lib\5.00562\Test\Harness.pm"
+"\PERL5.005\perl5.005_62\lib\Text\Abbrev.pm"-"!:\perl\lib\5.00562\Text\Abbrev.pm"
+"\PERL5.005\perl5.005_62\lib\Text\ParseWords.pm"-"!:\perl\lib\5.00562\Text\ParseWords.pm"
+"\PERL5.005\perl5.005_62\lib\Text\Soundex.pm"-"!:\perl\lib\5.00562\Text\Soundex.pm"
+"\PERL5.005\perl5.005_62\lib\Text\Tabs.pm"-"!:\perl\lib\5.00562\Text\Tabs.pm"
+"\PERL5.005\perl5.005_62\lib\Text\Wrap.pm"-"!:\perl\lib\5.00562\Text\Wrap.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\Array.pm"-"!:\perl\lib\5.00562\Tie\Array.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\Handle.pm"-"!:\perl\lib\5.00562\Tie\Handle.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\Hash.pm"-"!:\perl\lib\5.00562\Tie\Hash.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\RefHash.pm"-"!:\perl\lib\5.00562\Tie\RefHash.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\Scalar.pm"-"!:\perl\lib\5.00562\Tie\Scalar.pm"
+"\PERL5.005\perl5.005_62\lib\Tie\SubstrHash.pm"-"!:\perl\lib\5.00562\Tie\SubstrHash.pm"
+"\PERL5.005\perl5.005_62\lib\Time\Local.pm"-"!:\perl\lib\5.00562\Time\Local.pm"
+"\PERL5.005\perl5.005_62\lib\Time\GMTIME.PM"-"!:\perl\lib\5.00562\Time\GMTIME.PM"
+"\PERL5.005\perl5.005_62\lib\Time\localtime.pm"-"!:\perl\lib\5.00562\Time\localtime.pm"
+"\PERL5.005\perl5.005_62\lib\Time\TM.PM"-"!:\perl\lib\5.00562\Time\TM.PM"
+"\PERL5.005\perl5.005_62\lib\UNIVERSAL.pm"-"!:\perl\lib\5.00562\UNIVERSAL.pm"
+"\PERL5.005\perl5.005_62\lib\ABBREV.PL"-"!:\perl\lib\5.00562\ABBREV.PL"
+"\PERL5.005\perl5.005_62\lib\ASSERT.PL"-"!:\perl\lib\5.00562\ASSERT.PL"
+"\PERL5.005\perl5.005_62\lib\attributes.pm"-"!:\perl\lib\5.00562\attributes.pm"
+"\PERL5.005\perl5.005_62\lib\AUTOUSE.PM"-"!:\perl\lib\5.00562\AUTOUSE.PM"
+"\PERL5.005\perl5.005_62\lib\BASE.PM"-"!:\perl\lib\5.00562\BASE.PM"
+"\PERL5.005\perl5.005_62\lib\BIGFLOAT.PL"-"!:\perl\lib\5.00562\BIGFLOAT.PL"
+"\PERL5.005\perl5.005_62\lib\BIGINT.PL"-"!:\perl\lib\5.00562\BIGINT.PL"
+"\PERL5.005\perl5.005_62\lib\BIGRAT.PL"-"!:\perl\lib\5.00562\BIGRAT.PL"
+"\PERL5.005\perl5.005_62\lib\BLIB.PM"-"!:\perl\lib\5.00562\BLIB.PM"
+"\PERL5.005\perl5.005_62\lib\CACHEOUT.PL"-"!:\perl\lib\5.00562\CACHEOUT.PL"
+"\PERL5.005\perl5.005_62\lib\CALLER.PM"-"!:\perl\lib\5.00562\CALLER.PM"
+"\PERL5.005\perl5.005_62\lib\charnames.pm"-"!:\perl\lib\5.00562\charnames.pm"
+"\PERL5.005\perl5.005_62\lib\CHAT2.PL"-"!:\perl\lib\5.00562\CHAT2.PL"
+"\PERL5.005\perl5.005_62\lib\COMPLETE.PL"-"!:\perl\lib\5.00562\COMPLETE.PL"
+"\PERL5.005\perl5.005_62\lib\CONSTANT.PM"-"!:\perl\lib\5.00562\CONSTANT.PM"
+"\PERL5.005\perl5.005_62\lib\CTIME.PL"-"!:\perl\lib\5.00562\CTIME.PL"
+"\PERL5.005\perl5.005_62\lib\diagnostics.pm"-"!:\perl\lib\5.00562\diagnostics.pm"
+"\PERL5.005\perl5.005_62\lib\DOTSH.PL"-"!:\perl\lib\5.00562\DOTSH.PL"
+"\PERL5.005\perl5.005_62\lib\DUMPVAR.PL"-"!:\perl\lib\5.00562\DUMPVAR.PL"
+"\PERL5.005\perl5.005_62\lib\exceptions.pl"-"!:\perl\lib\5.00562\exceptions.pl"
+"\PERL5.005\perl5.005_62\lib\FASTCWD.PL"-"!:\perl\lib\5.00562\FASTCWD.PL"
+"\PERL5.005\perl5.005_62\lib\FIELDS.PM"-"!:\perl\lib\5.00562\FIELDS.PM"
+"\PERL5.005\perl5.005_62\lib\FILETEST.PM"-"!:\perl\lib\5.00562\FILETEST.PM"
+"\PERL5.005\perl5.005_62\lib\FIND.PL"-"!:\perl\lib\5.00562\FIND.PL"
+"\PERL5.005\perl5.005_62\lib\finddepth.pl"-"!:\perl\lib\5.00562\finddepth.pl"
+"\PERL5.005\perl5.005_62\lib\FLUSH.PL"-"!:\perl\lib\5.00562\FLUSH.PL"
+"\PERL5.005\perl5.005_62\lib\FTP.PL"-"!:\perl\lib\5.00562\FTP.PL"
+"\PERL5.005\perl5.005_62\lib\GETCWD.PL"-"!:\perl\lib\5.00562\GETCWD.PL"
+"\PERL5.005\perl5.005_62\lib\GETOPT.PL"-"!:\perl\lib\5.00562\GETOPT.PL"
+"\PERL5.005\perl5.005_62\lib\GETOPTS.PL"-"!:\perl\lib\5.00562\GETOPTS.PL"
+"\PERL5.005\perl5.005_62\lib\HOSTNAME.PL"-"!:\perl\lib\5.00562\HOSTNAME.PL"
+"\PERL5.005\perl5.005_62\lib\importenv.pl"-"!:\perl\lib\5.00562\importenv.pl"
+"\PERL5.005\perl5.005_62\lib\INTEGER.PM"-"!:\perl\lib\5.00562\INTEGER.PM"
+"\PERL5.005\perl5.005_62\lib\LESS.PM"-"!:\perl\lib\5.00562\LESS.PM"
+"\PERL5.005\perl5.005_62\lib\LIB.PM"-"!:\perl\lib\5.00562\LIB.PM"
+"\PERL5.005\perl5.005_62\lib\LOCALE.PM"-"!:\perl\lib\5.00562\LOCALE.PM"
+"\PERL5.005\perl5.005_62\lib\LOOK.PL"-"!:\perl\lib\5.00562\LOOK.PL"
+"\PERL5.005\perl5.005_62\lib\newgetopt.pl"-"!:\perl\lib\5.00562\newgetopt.pl"
+"\PERL5.005\perl5.005_62\lib\OPEN2.PL"-"!:\perl\lib\5.00562\OPEN2.PL"
+"\PERL5.005\perl5.005_62\lib\OPEN3.PL"-"!:\perl\lib\5.00562\OPEN3.PL"
+"\PERL5.005\perl5.005_62\lib\OVERLOAD.PM"-"!:\perl\lib\5.00562\OVERLOAD.PM"
+"\PERL5.005\perl5.005_62\lib\PERL5DB.PL"-"!:\perl\lib\5.00562\PERL5DB.PL"
+"\PERL5.005\perl5.005_62\lib\PWD.PL"-"!:\perl\lib\5.00562\PWD.PL"
+"\PERL5.005\perl5.005_62\lib\shellwords.pl"-"!:\perl\lib\5.00562\shellwords.pl"
+"\PERL5.005\perl5.005_62\lib\SIGTRAP.PM"-"!:\perl\lib\5.00562\SIGTRAP.PM"
+"\PERL5.005\perl5.005_62\lib\STAT.PL"-"!:\perl\lib\5.00562\STAT.PL"
+"\PERL5.005\perl5.005_62\lib\STRICT.PM"-"!:\perl\lib\5.00562\STRICT.PM"
+"\PERL5.005\perl5.005_62\lib\SUBS.PM"-"!:\perl\lib\5.00562\SUBS.PM"
+"\PERL5.005\perl5.005_62\lib\SYSLOG.PL"-"!:\perl\lib\5.00562\SYSLOG.PL"
+"\PERL5.005\perl5.005_62\lib\TAINTED.PL"-"!:\perl\lib\5.00562\TAINTED.PL"
+"\PERL5.005\perl5.005_62\lib\TERMCAP.PL"-"!:\perl\lib\5.00562\TERMCAP.PL"
+"\PERL5.005\perl5.005_62\lib\timelocal.pl"-"!:\perl\lib\5.00562\timelocal.pl"
+"\PERL5.005\perl5.005_62\lib\UTF8.PM"-"!:\perl\lib\5.00562\UTF8.PM"
+"\PERL5.005\perl5.005_62\lib\utf8_heavy.pl"-"!:\perl\lib\5.00562\utf8_heavy.pl"
+"\PERL5.005\perl5.005_62\lib\VALIDATE.PL"-"!:\perl\lib\5.00562\VALIDATE.PL"
+"\PERL5.005\perl5.005_62\lib\VARS.PM"-"!:\perl\lib\5.00562\VARS.PM"
+"\PERL5.005\perl5.005_62\lib\WARNINGS.PM"-"!:\perl\lib\5.00562\WARNINGS.PM"
@"\epoc32\release\marm\rel\stdlib.sis",(0x010002c3)
# License or the Artistic License, as specified in the README file.
#
package B;
-require DynaLoader;
+use XSLoader ();
require Exporter;
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT_OK = qw(minus_c ppname
class peekop cast_I32 cstring cchar hash threadsv_names
main_root main_start main_cv svref_2object opnumber amagic_generation
@B::LOGOP::ISA = 'B::UNOP';
@B::LISTOP::ISA = 'B::BINOP';
@B::SVOP::ISA = 'B::OP';
-@B::GVOP::ISA = 'B::OP';
+@B::PADOP::ISA = 'B::OP';
@B::PVOP::ISA = 'B::OP';
@B::CVOP::ISA = 'B::OP';
@B::LOOP::ISA = 'B::LISTOP';
}
}
-bootstrap B;
+XSLoader::load 'B';
1;
=item LINE
+=item FILE
+
=item FILEGV
=item GvREFCNT
=item GV
-=item FILEGV
+=item FILE
=item DEPTH
=head2 OP-RELATED CLASSES
B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
-B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
+B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
These classes correspond in
the obvious way to the underlying C structures of similar names. The
inheritance hierarchy mimics the underlying C "inheritance". Access
=item sv
+=item gv
+
=back
-=head2 B::GVOP METHOD
+=head2 B::PADOP METHOD
=over 4
-=item gv
+=item padix
=back
=item stash
-=item filegv
+=item file
=item cop_seq
OPc_LISTOP, /* 5 */
OPc_PMOP, /* 6 */
OPc_SVOP, /* 7 */
- OPc_GVOP, /* 8 */
+ OPc_PADOP, /* 8 */
OPc_PVOP, /* 9 */
OPc_CVOP, /* 10 */
OPc_LOOP, /* 11 */
"B::LISTOP",
"B::PMOP",
"B::SVOP",
- "B::GVOP",
+ "B::PADOP",
"B::PVOP",
"B::CVOP",
"B::LOOP",
case OA_SVOP:
return OPc_SVOP;
- case OA_GVOP:
- return OPc_GVOP;
+ case OA_PADOP:
+ return OPc_PADOP;
case OA_PVOP_OR_SVOP:
/*
* return OPc_UNOP so that walkoptree can find our children. If
* OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
* (no argument to the operator) it's an OP; with OPf_REF set it's
- * a GVOP (and op_gv is the GV for the filehandle argument).
+ * an SVOP (and op_sv is the GV for the filehandle argument).
*/
return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
- (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
+ (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
case OA_LOOPEXOP:
/*
typedef LISTOP *B__LISTOP;
typedef PMOP *B__PMOP;
typedef SVOP *B__SVOP;
-typedef GVOP *B__GVOP;
+typedef PADOP *B__PADOP;
typedef PVOP *B__PVOP;
typedef LOOP *B__LOOP;
typedef COP *B__COP;
char *s;
STRLEN len;
U32 hash = 0;
- char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */
+ char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
s = SvPV(sv, len);
PERL_HASH(hash, s, len);
- sprintf(hexhash, "0x%x", hash);
+ sprintf(hexhash, "0x%"UVxf, (UV)hash);
ST(0) = sv_2mortal(newSVpv(hexhash, 0));
#define cast_I32(foo) (I32)foo
OP_desc(o)
B::OP o
-U16
+PADOFFSET
OP_targ(o)
B::OP o
if (rx)
sv_setpvn(ST(0), rx->precomp, rx->prelen);
-#define SVOP_sv(o) o->op_sv
+#define SVOP_sv(o) cSVOPx_sv(o)
+#define SVOP_gv(o) cGVOPx_gv(o)
MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
-
B::SV
SVOP_sv(o)
B::SVOP o
-#define GVOP_gv(o) o->op_gv
+B::GV
+SVOP_gv(o)
+ B::SVOP o
+
+#define PADOP_padix(o) o->op_padix
+#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
+#define PADOP_gv(o) ((o->op_padix \
+ && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
+ ? (GV*)PL_curpad[o->op_padix] : Nullgv)
-MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_
+MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
+PADOFFSET
+PADOP_padix(o)
+ B::PADOP o
+
+B::SV
+PADOP_sv(o)
+ B::PADOP o
B::GV
-GVOP_gv(o)
- B::GVOP o
+PADOP_gv(o)
+ B::PADOP o
MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
B::LOOP o
#define COP_label(o) o->cop_label
-#define COP_stash(o) o->cop_stash
-#define COP_filegv(o) o->cop_filegv
+#define COP_stashpv(o) CopSTASHPV(o)
+#define COP_stash(o) CopSTASH(o)
+#define COP_file(o) CopFILE(o)
#define COP_cop_seq(o) o->cop_seq
#define COP_arybase(o) o->cop_arybase
-#define COP_line(o) o->cop_line
+#define COP_line(o) CopLINE(o)
#define COP_warnings(o) o->cop_warnings
MODULE = B PACKAGE = B::COP PREFIX = COP_
COP_label(o)
B::COP o
+char *
+COP_stashpv(o)
+ B::COP o
+
B::HV
COP_stash(o)
B::COP o
-B::GV
-COP_filegv(o)
+char *
+COP_file(o)
B::COP o
U32
GvLINE(gv)
B::GV gv
+char *
+GvFILE(gv)
+ B::GV gv
+
B::GV
GvFILEGV(gv)
B::GV gv
CvGV(cv)
B::CV cv
-B::GV
-CvFILEGV(cv)
+char *
+CvFILE(cv)
B::CV cv
long
@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
use vars qw(%insn_data @insn_name @optype @specialsv_name);
-@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
+@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
# XXX insn_data is initialised this way because with a large
$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"];
$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"];
$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_filegv} = [48, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"];
$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"];
$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"];
$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_filegv} = [75, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_file} = [75, \&PUT_pvcontents, "GET_pvcontents"];
$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"];
$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"];
$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
$insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"];
$insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"];
$insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_gv} = [102, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"];
$insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"];
$insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"];
$insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"];
$insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"];
$insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"];
$insn_data{cop_label} = [108, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_stash} = [109, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_filegv} = [110, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_stashpv} = [109, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_file} = [110, \&PUT_pvcontents, "GET_pvcontents"];
$insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"];
$insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"];
$insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"];
$sv->bytecode;
}
-sub B::GVOP::bytecode {
+sub B::PADOP::bytecode {
my $op = shift;
- my $gv = $op->gv;
- my $gvix = $gv->objix;
+ my $padix = $op->padix;
$op->B::OP::bytecode;
- print "op_gv $gvix\n";
- $gv->bytecode;
+ print "op_padix $padix\n";
}
sub B::PVOP::bytecode {
sub B::COP::bytecode {
my $op = shift;
- my $stash = $op->stash;
- my $stashix = $stash->objix;
- my $filegv = $op->filegv;
- my $filegvix = $filegv->objix;
+ my $stashpv = $op->stashpv;
+ my $file = $op->file;
my $line = $op->line;
my $warnings = $op->warnings;
my $warningsix = $warnings->objix;
if ($debug_bc) {
- printf "# line %s:%d\n", $filegv->SV->PV, $line;
+ printf "# line %s:%d\n", $file, $line;
}
$op->B::OP::bytecode;
- printf <<"EOT", pvstring($op->label), $op->cop_seq, $op->arybase;
+ printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase;
newpv %s
cop_label
-cop_stash $stashix
+newpv %s
+cop_stashpv
cop_seq %d
-cop_filegv $filegvix
+newpv %s
+cop_file
cop_arybase %d
cop_line $line
cop_warnings $warningsix
EOT
- $filegv->bytecode;
- $stash->bytecode;
}
sub B::PMOP::bytecode {
my $egv = $gv->EGV;
my $egvix = $egv->objix;
ldsv($ix);
- printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE;
+ printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE, pvstring($gv->FILE);
sv_flags 0x%x
xgv_flags 0x%x
gp_line %d
+newpv %s
+gp_file
EOT
my $refcnt = $gv->REFCNT;
printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
} else {
if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
my $i;
- my @subfield_names = qw(SV AV HV CV FILEGV FORM IO);
+ my @subfield_names = qw(SV AV HV CV FORM IO);
my @subfields = map($gv->$_(), @subfield_names);
my @ixes = map($_->objix, @subfields);
# Reset sv register for $gv
my $ix = $cv->objix;
$cv->B::PVMG::bytecode;
my $i;
- my @subfield_names = qw(ROOT START STASH GV FILEGV PADLIST OUTSIDE);
+ my @subfield_names = qw(ROOT START STASH GV PADLIST OUTSIDE);
my @subfields = map($cv->$_(), @subfield_names);
my @ixes = map($_->objix, @subfields);
# Save OP tree from CvROOT (first element of @subfields)
printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
}
printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS;
+ printf "newpv %s\nxcv_file\n", pvstring($cv->FILE);
# Now save all the subfields (except for CvROOT which was handled
# above) and CvSTART (now the initial element of @subfields).
shift @subfields; # bye-bye CvSTART
$arg ||= shift @options;
open(OUT, ">$arg") or return "$arg: $!\n";
binmode OUT;
+ } elsif ($opt eq "a") {
+ $arg ||= shift @options;
+ open(OUT, ">>$arg") or return "$arg: $!\n";
+ binmode OUT;
} elsif ($opt eq "D") {
$arg ||= shift @options;
foreach $arg (split(//, $arg)) {
Output to filename instead of STDOUT.
+=item B<-afilename>
+
+Append output to filename.
+
=item B<-->
Force end of options.
# Code sections
my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect,
- $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
+ $padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
$pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
$xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
$xrvsect, $xpvbmsect, $xpviosect );
savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index));
}
-sub B::GVOP::save {
+sub B::PADOP::save {
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- my $gvsym = $op->gv->save;
- $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv",
+ $padopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv",
${$op->next}, ${$op->sibling}, $op->ppaddr,
$op->targ, $op->type, $op_seq, $op->flags,
$op->private));
- $init->add(sprintf("gvop_list[%d].op_gv = %s;", $gvopsect->index, $gvsym));
- savesym($op, sprintf("(OP*)&gvop_list[%d]", $gvopsect->index));
+ $init->add(sprintf("padop_list[%d].op_padix = %ld;",
+ $padopsect->index, $op->padix));
+ savesym($op, sprintf("(OP*)&padop_list[%d]", $padopsect->index));
}
sub B::COP::save {
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- my $gvsym = $op->filegv->save;
- my $stashsym = $op->stash->save;
- warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
+ warn sprintf("COP: line %d file %s\n", $op->line, $op->file)
if $debug_cops;
$copsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
${$op->next}, ${$op->sibling}, $op->ppaddr,
$op->private, cstring($op->label), $op->cop_seq,
$op->arybase, $op->line));
my $copix = $copsect->index;
- $init->add(sprintf("cop_list[%d].cop_filegv = %s;", $copix, $gvsym),
- sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym));
+ $init->add(sprintf("CopFILE_set(&cop_list[%d], %s);", $copix, cstring($op->file)),
+ sprintf("CopSTASHPV_set(&cop_list[%d], %s);", $copix, cstring($op->stashpv)));
savesym($op, "(OP*)&cop_list[$copix]");
}
my $stashname = $egv->STASH->NAME;
if ($cvname eq "bootstrap")
{
- my $file = $cv->FILEGV->SV->PV;
+ my $file = $gv->FILE;
$decl->add("/* bootstrap $file */");
warn "Bootstrap $stashname $file\n";
$xsub{$stashname}='Dynamic';
warn sprintf("done saving GV 0x%x for CV 0x%x\n",
$$gv, $$cv) if $debug_cv;
}
- my $filegv = $cv->FILEGV;
- if ($$filegv) {
- $filegv->save;
- $init->add(sprintf("CvFILEGV(s\\_%x) = s\\_%x;", $$cv, $$filegv));
- warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n",
- $$filegv, $$cv) if $debug_cv;
- }
+ $init->add(sprintf("CvFILE($sym) = %s;", cstring($cv->FILE)));
my $stash = $cv->STASH;
if ($$stash) {
$stash->save;
# warn "GV::save &$name\n"; # debug
}
}
- my $gvfilegv = $gv->FILEGV;
- if ($$gvfilegv) {
- $gvfilegv->save;
- $init->add(sprintf("GvFILEGV($sym) = (GV*)s\\_%x;",$$gvfilegv));
-# warn "GV::save GvFILEGV(*$name)\n"; # debug
- }
+ $init->add(sprintf("GvFILE($sym) = %s;", cstring($gv->FILE)));
+# warn "GV::save GvFILE(*$name)\n"; # debug
my $gvform = $gv->FORM;
if ($$gvform) {
$gvform->save;
my $init_name = shift;
my $section;
my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
- $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect,
+ $listopsect, $pmopsect, $svopsect, $padopsect, $pvopsect,
$loopsect, $copsect, $svsect, $xpvsect,
$xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
$xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
void (*xcv_xsub) (CV*);
void * xcv_xsubany;
GV * xcv_gv;
- GV * xcv_filegv;
- long xcv_depth; /* >= 2 indicates recursive call */
+ char * xcv_file;
+ long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
#ifdef USE_THREADS
sub init_sections {
my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
binop => \$binopsect, condop => \$condopsect,
- cop => \$copsect, gvop => \$gvopsect,
+ cop => \$copsect, padop => \$padopsect,
listop => \$listopsect, logop => \$logopsect,
loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
sub error {
my $format = shift;
- my $file = $curcop->[0]->filegv->SV->PV;
+ my $file = $curcop->[0]->file;
my $line = $curcop->[0]->line;
$errors++;
if (@_) {
my $op = shift;
$curcop->load($op);
@stack = ();
- debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
+ debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno;
runtime("TAINT_NOT;") unless $omit_taint;
runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
if ($freetmps_each_bblock || $freetmps_each_loop) {
perl_init();
ENTER;
SAVETMPS;
- SAVESPTR(PL_curpad);
- SAVESPTR(PL_op);
+ SAVEVPTR(PL_curpad);
+ SAVEVPTR(PL_op);
PL_curpad = AvARRAY($curpad_sym);
PL_op = $start;
pp_main(aTHX);
sub B::COP::debug {
my ($op) = @_;
$op->B::OP::debug();
- my ($filegv) = $op->filegv;
- printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line, ${$op->warnings};
+ printf <<'EOT', $op->label, $op->stashpv, $op->file, $op->seq, $op->arybase, $op->line, ${$op->warnings};
cop_label %s
- cop_stash 0x%x
- cop_filegv 0x%x
+ cop_stashpv %s
+ cop_file %s
cop_seq %d
cop_arybase %d
cop_line %d
cop_warnings 0x%x
EOT
- $filegv->debug;
}
sub B::SVOP::debug {
printf "\top_pv\t\t0x%x\n", $op->pv;
}
-sub B::GVOP::debug {
+sub B::PADOP::debug {
my ($op) = @_;
$op->B::OP::debug();
- printf "\top_gv\t\t0x%x\n", ${$op->gv};
- $op->gv->debug;
+ printf "\top_padix\t\t%ld\n", $op->padix;
}
sub B::CVOP::debug {
my ($start) = $sv->START;
my ($root) = $sv->ROOT;
my ($padlist) = $sv->PADLIST;
+ my ($file) = $sv->FILE;
my ($gv) = $sv->GV;
- my ($filegv) = $sv->FILEGV;
- printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+ printf <<'EOT', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
STASH 0x%x
START 0x%x
ROOT 0x%x
GV 0x%x
- FILEGV 0x%x
+ FILE %s
DEPTH %d
PADLIST 0x%x
OUTSIDE 0x%x
$start->debug if $start;
$root->debug if $root;
$gv->debug if $gv;
- $filegv->debug if $filegv;
$padlist->debug if $padlist;
}
my ($av) = $gv->AV;
my ($cv) = $gv->CV;
$gv->B::SV::debug;
- printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS;
+ printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS;
NAME %s
STASH %s (0x%x)
SV 0x%x
CV 0x%x
CVGEN %d
LINE %d
- FILEGV 0x%x
+ FILE %s
GvFLAGS 0x%x
EOT
$sv->debug if $sv;
and $seq > $self->{'subs_todo'}[0][0]) {
push @text, $self->next_todo;
}
- my $stash = $op->stash->NAME;
+ my $stash = $op->stashpv;
if ($stash ne $self->{'curstash'}) {
push @text, "package $stash;\n";
$self->{'curstash'} = $stash;
}
if ($self->{'linenums'}) {
push @text, "\f#line " . $op->line .
- ' "' . substr($op->filegv->NAME, 2), qq'"\n';
+ ' "' . $op->file, qq'"\n';
}
return join("", @text);
}
# Genuine `-X' filetests are exempt from the LLAFR, but not
# l?stat(); for the sake of clarity, give'em all parens
return $self->maybe_parens_unop($name, $op->first, $cx);
- } elsif (class($op) eq "GVOP") {
+ } elsif (class($op) eq "SVOP") {
return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16);
} else { # I don't think baseop filetests ever survive ck_ftst, but...
return $name;
sub B::COP::lint {
my $op = shift;
if ($op->name eq "nextstate") {
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$curstash = $op->stash->NAME;
}
}
}
-sub B::GVOP::lint {
+sub B::SVOP::lint {
my $op = shift;
if ($check{dollar_underscore} && $op->name eq "gvsv"
&& $op->gv->NAME eq "_")
}
if ($check{private_names}) {
my $opname = $op->name;
- my $gv = $op->gv;
- if (($opname eq "gv" || $opname eq "gvsv")
- && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
- {
- warning('Illegal reference to private name %s', $gv->NAME);
+ if ($opname eq "gv" || $opname eq "gvsv") {
+ my $gv = $op->gv;
+ if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
+ warning('Illegal reference to private name %s', $gv->NAME);
+ }
}
}
if ($check{undefined_subs}) {
BEGIN { %Seen = %INC }
-END {
+STOP {
my @arr=scan($main::{"main::"});
@arr=map{s/\:\:$//;$_;} @arr;
print "-umain,-u", join (",-u",@arr) ,"\n";
$op->sv->terse(0);
}
-sub B::GVOP::terse {
+sub B::PADOP::terse {
my ($op, $level) = @_;
- print indent($level), peekop($op), " ";
- $op->gv->terse(0);
+ print indent($level), peekop($op), " ", $op->padix, "\n";
}
sub B::PMOP::terse {
sub pp_nextstate {
my $op = shift;
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$top = UNKNOWN;
}
my $cv = $gv->CV;
if ($$cv) {
#return if $done{$$cv}++;
- $file = $gv->FILEGV->SV->PV;
+ $file = $gv->FILE;
$line = $gv->LINE;
process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
push(@todo, $cv);
my $form = $gv->FORM;
if ($$form) {
return if $done{$$form}++;
- $file = $gv->FILEGV->SV->PV;
+ $file = $gv->FILE;
$line = $gv->LINE;
process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
}
it should return a sub ref (usually a closure) to perform the
actual compilation. When O regains control, it ensures that the
"-c" option is forced (so that the program being compiled doesn't
- end up running) and registers an END block to call back the sub ref
+ end up running) and registers a STOP block to call back the sub ref
returned from the backend's compile(). Perl then continues by
parsing prog.pl (just as it would with "perl -c prog.pl") and after
- doing so, assuming there are no parse-time errors, the END block
+ doing so, assuming there are no parse-time errors, the STOP block
of O gets called and the actual backend compilation happens. Phew.
my $compilesub = &{"B::${backend}::compile"}(@options);
if (ref($compilesub) eq "CODE") {
minus_c;
- eval 'END { &$compilesub() }';
+ eval 'STOP { &$compilesub() }';
} else {
die $compilesub;
}
package, passing it OPTIONS. That function is expected to return
a sub reference which we'll call CALLBACK. Next, the "compile-only"
flag is switched on (equivalent to the command-line option C<-c>)
-and an END block is registered which calls CALLBACK. Thus the main
+and a STOP block is registered which calls CALLBACK. Thus the main
Perl program mentioned on the command-line is read in, parsed and
compiled into internal syntax tree form. Since the C<-c> flag is
set, the program does not start running (excepting BEGIN blocks of
B::LISTOP T_OP_OBJ
B::PMOP T_OP_OBJ
B::SVOP T_OP_OBJ
-B::GVOP T_OP_OBJ
+B::PADOP T_OP_OBJ
B::PVOP T_OP_OBJ
B::CVOP T_OP_OBJ
B::LOOP T_OP_OBJ
B::MAGIC T_MG_OBJ
SSize_t T_IV
STRLEN T_IV
+PADOFFSET T_UV
INPUT
T_OP_OBJ
package ByteLoader;
-require DynaLoader;
-
-@ISA = qw(DynaLoader);
+use XSLoader ();
$VERSION = 0.03;
-bootstrap ByteLoader $VERSION;
+XSLoader::load 'ByteLoader', $VERSION;
# Preloaded methods go here.
#include "XSUB.h"
#include "byterun.h"
-#ifdef NEED_FGETC_PROTOTYPE
-extern int fgetc();
-#endif
-#ifdef NEED_FREAD_PROTOTYPE
-extern int fread();
-#endif
+static int
+xgetc(PerlIO *io)
+{
+ dTHX;
+ return PerlIO_getc(io);
+}
+
+static int
+xfread(char *buf, size_t size, size_t n, PerlIO *io)
+{
+ dTHX;
+ int i = PerlIO_read(io, buf, n * size);
+ if (i > 0)
+ i /= size;
+ return i;
+}
static void
freadpv(U32 len, void *data, XPV *pv)
struct bytestream bs;
bs.data = PL_rsfp;
- bs.pfgetc = (int(*) (void*))fgetc;
- bs.pfread = (int(*) (char*,size_t,size_t,void*))fread;
+ bs.pfgetc = (int(*) (void*))xgetc;
+ bs.pfread = (int(*) (char*,size_t,size_t,void*))xfread;
bs.pfreadpv = freadpv;
byterun(aTHXo_ bs);
PL_comppad = (AV *)arg; \
pad = AvARRAY(arg); \
} STMT_END
+#define BSET_cop_file(cop, arg) CopFILE_set(cop,arg)
+#define BSET_cop_line(cop, arg) CopLINE_set(cop,arg)
+#define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg)
#define BSET_OBJ_STORE(obj, ix) \
(I32)ix > bytecode_obj_list_fill ? \
sizeof(LISTOP),
sizeof(PMOP),
sizeof(SVOP),
- sizeof(GVOP),
+ sizeof(PADOP),
sizeof(PVOP),
sizeof(LOOP),
sizeof(COP)
*(SV**)&CvGV(bytecode_sv) = arg;
break;
}
- case INSN_XCV_FILEGV: /* 48 */
+ case INSN_XCV_FILE: /* 48 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&CvFILEGV(bytecode_sv) = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ CvFILE(bytecode_sv) = arg;
break;
}
case INSN_XCV_DEPTH: /* 49 */
*(SV**)&GvCV(bytecode_sv) = arg;
break;
}
- case INSN_GP_FILEGV: /* 75 */
+ case INSN_GP_FILE: /* 75 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&GvFILEGV(bytecode_sv) = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ GvFILE(bytecode_sv) = arg;
break;
}
case INSN_GP_IO: /* 76 */
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_GV: /* 102 */
+ case INSN_OP_PADIX: /* 102 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&cGVOP->op_gv = arg;
+ PADOFFSET arg;
+ BGET_U32(arg);
+ cPADOP->op_padix = arg;
break;
}
case INSN_OP_PV: /* 103 */
cCOP->cop_label = arg;
break;
}
- case INSN_COP_STASH: /* 109 */
+ case INSN_COP_STASHPV: /* 109 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&cCOP->cop_stash = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ BSET_cop_stashpv(cCOP, arg);
break;
}
- case INSN_COP_FILEGV: /* 110 */
+ case INSN_COP_FILE: /* 110 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&cCOP->cop_filegv = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ BSET_cop_file(cCOP, arg);
break;
}
case INSN_COP_SEQ: /* 111 */
{
line_t arg;
BGET_U16(arg);
- cCOP->cop_line = arg;
+ BSET_cop_line(cCOP, arg);
break;
}
case INSN_COP_WARNINGS: /* 114 */
INSN_XCV_START, /* 45 */
INSN_XCV_ROOT, /* 46 */
INSN_XCV_GV, /* 47 */
- INSN_XCV_FILEGV, /* 48 */
+ INSN_XCV_FILE, /* 48 */
INSN_XCV_DEPTH, /* 49 */
INSN_XCV_PADLIST, /* 50 */
INSN_XCV_OUTSIDE, /* 51 */
INSN_GP_AV, /* 72 */
INSN_GP_HV, /* 73 */
INSN_GP_CV, /* 74 */
- INSN_GP_FILEGV, /* 75 */
+ INSN_GP_FILE, /* 75 */
INSN_GP_IO, /* 76 */
INSN_GP_FORM, /* 77 */
INSN_GP_CVGEN, /* 78 */
INSN_OP_PMFLAGS, /* 99 */
INSN_OP_PMPERMFLAGS, /* 100 */
INSN_OP_SV, /* 101 */
- INSN_OP_GV, /* 102 */
+ INSN_OP_PADIX, /* 102 */
INSN_OP_PV, /* 103 */
INSN_OP_PV_TR, /* 104 */
INSN_OP_REDOOP, /* 105 */
INSN_OP_NEXTOP, /* 106 */
INSN_OP_LASTOP, /* 107 */
INSN_COP_LABEL, /* 108 */
- INSN_COP_STASH, /* 109 */
- INSN_COP_FILEGV, /* 110 */
+ INSN_COP_STASHPV, /* 109 */
+ INSN_COP_FILE, /* 110 */
INSN_COP_SEQ, /* 111 */
INSN_COP_ARYBASE, /* 112 */
INSN_COP_LINE, /* 113 */
OPt_LISTOP, /* 4 */
OPt_PMOP, /* 5 */
OPt_SVOP, /* 6 */
- OPt_GVOP, /* 7 */
+ OPt_PADOP, /* 7 */
OPt_PVOP, /* 8 */
OPt_LOOP, /* 9 */
OPt_COP /* 10 */
require Tie::Hash;
require Exporter;
use AutoLoader;
-require DynaLoader;
-@ISA = qw(Tie::Hash Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Tie::Hash Exporter);
@EXPORT = qw(
$DB_BTREE $DB_HASH $DB_RECNO
# };
#}
-bootstrap DB_File $VERSION;
+XSLoader::load 'DB_File', $VERSION;
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
package Data::Dumper;
-$VERSION = $VERSION = '2.101';
+$VERSION = '2.101';
#$| = 1;
require 5.004_02;
require Exporter;
-require DynaLoader;
+use XSLoader ();
require overload;
use Carp;
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT = qw(Dumper);
@EXPORT_OK = qw(DumperX);
-bootstrap Data::Dumper;
+XSLoader::load 'Data::Dumper';
# module vars and their defaults
$Indent = 2 unless defined $Indent;
=head1 AUTHOR
-Gurusamy Sarathy gsar@umich.edu
+Gurusamy Sarathy gsar@activestate.com
Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
This program is free software; you can redistribute it and/or
}
if (isIDFIRST(*s)) {
while (*++s)
- if (!isALNUM(*s))
+ if (!isALNUM(*s)) {
if (*s == ':')
goto TOP;
else
return 1;
+ }
}
else
return 1;
ilen = inamelen;
sv_setiv(ixsv, ix);
- (void) sprintf(iname+ilen, "%ld", ix);
+ (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
ilen = strlen(iname);
iname[ilen++] = ']'; iname[ilen] = '\0';
if (indent >= 3) {
if (SvIOK(val)) {
STRLEN len;
i = SvIV(val);
- (void) sprintf(tmpbuf, "%d", i);
+ (void) sprintf(tmpbuf, "%"IVdf, (IV)i);
len = strlen(tmpbuf);
sv_catpvn(retval, tmpbuf, len);
}
SV **svp;
SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
SV *freezer, *toaster, *bless;
- I32 purity, deepcopy, quotekeys, maxdepth;
+ I32 purity, deepcopy, quotekeys, maxdepth = 0;
char tmpbuf[1024];
I32 gimme = GIMME;
STRLEN nchars = 0;
sv_setpvn(name, "$", 1);
sv_catsv(name, varname);
- (void) sprintf(tmpbuf, "%ld", i+1);
+ (void) sprintf(tmpbuf, "%"IVdf, (IV)(i+1));
nchars = strlen(tmpbuf);
sv_catpvn(name, tmpbuf, nchars);
}
# print "nonXS DBDB\n";
}
-require DynaLoader;
-@Devel::DProf::ISA = 'DynaLoader';
+use XSLoader ();
+
$Devel::DProf::VERSION = '19990108'; # this version not authorized by
# Dean Roehrich. See "Changes" file.
-bootstrap Devel::DProf $Devel::DProf::VERSION;
+XSLoader::load 'Devel::DProf', $Devel::DProf::VERSION;
1;
XS(XS_Devel__DProf_END); /* used by prof_mark() */
-static SV * Sub; /* pointer to $DB::sub */
static PerlIO *fp; /* pointer to tmon.out file */
/* Added -JH */
prof_dumpa(opcode ptype, U32 id)
{
if(ptype == OP_LEAVESUB){
- PerlIO_printf(fp,"- %lx\n", id );
+ PerlIO_printf(fp,"- %"UVxf"\n", (UV)id );
} else if(ptype == OP_ENTERSUB) {
- PerlIO_printf(fp,"+ %lx\n", id );
+ PerlIO_printf(fp,"+ %"UVxf"\n", (UV)id );
} else if(ptype == OP_GOTO) {
- PerlIO_printf(fp,"* %lx\n", id );
+ PerlIO_printf(fp,"* %"UVxf"\n", (UV)id );
} else if(ptype == OP_DIE) {
- PerlIO_printf(fp,"/ %lx\n", id );
+ PerlIO_printf(fp,"/ %"UVxf"\n", (UV)id );
} else {
PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype);
}
static void
prof_dumps(U32 id, char *pname, char *gname)
{
- PerlIO_printf(fp,"& %lx %s %s\n", id, pname, gname);
+ PerlIO_printf(fp,"& %"UVxf" %s %s\n", (UV)id, pname, gname);
}
static clock_t otms_utime, otms_stime, orealtime;
wprof_s += t2.tms_stime - t1.tms_stime;
PerlIO_printf(fp,"+ & Devel::DProf::write\n" );
- PerlIO_printf(fp,"@ %ld %ld %ld\n",
- t2.tms_utime - t1.tms_utime, t2.tms_stime - t1.tms_stime,
- realtime2 - realtime1);
+ PerlIO_printf(fp,"@ %"IVdf" %"IVdf" %"IVdf"\n",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)(t2.tms_utime - t1.tms_utime),
+ (IV)(t2.tms_stime - t1.tms_stime),
+ (IV)(realtime2 - realtime1));
PerlIO_printf(fp,"- & Devel::DProf::write\n" );
otms_utime = t2.tms_utime;
otms_stime = t2.tms_stime;
STRLEN len;
SV *sv;
U32 id;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
if( SAVE_STACK ){
if( profstack_ix + 5 > profstack_max ){
/* fp is opened in the BOOT section */
PerlIO_printf(fp, "#fOrTyTwO\n" );
- PerlIO_printf(fp, "$hz=%d;\n", DPROF_HZ );
+ PerlIO_printf(fp, "$hz=%"IVdf";\n", (IV)DPROF_HZ );
PerlIO_printf(fp, "$XS_VERSION='DProf %s';\n", XS_VERSION );
PerlIO_printf(fp, "# All values are given in HZ\n" );
test_time(&r, &u, &s);
- PerlIO_printf(fp, "$over_utime=%ld; $over_stime=%ld; $over_rtime=%ld;\n",
- u, s, r);
+ PerlIO_printf(fp,
+ "$over_utime=%"IVdf"; $over_stime=%"IVdf"; $over_rtime=%"IVdf";\n",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)u, (IV)s, (IV)r);
PerlIO_printf(fp, "$over_tests=10000;\n");
TIMES_LOCATION = PerlIO_tell(fp);
}
PerlIO_seek(fp, TIMES_LOCATION, SEEK_SET);
/* Write into reserved 240 bytes: */
- PerlIO_printf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld;",
- prof_end.tms_utime - prof_start.tms_utime - wprof_u,
- prof_end.tms_stime - prof_start.tms_stime - wprof_s,
- rprof_end - rprof_start - wprof_r );
- PerlIO_printf(fp, "\n$total_marks=%ld;", total);
+ PerlIO_printf(fp,
+ "$rrun_utime=%"IVdf"; $rrun_stime=%"IVdf"; $rrun_rtime=%"IVdf";",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)(prof_end.tms_utime-prof_start.tms_utime-wprof_u),
+ (IV)(prof_end.tms_stime-prof_start.tms_stime-wprof_s),
+ (IV)(rprof_end-rprof_start-wprof_r) );
+ PerlIO_printf(fp, "\n$total_marks=%"IVdf, (IV)total);
PerlIO_close( fp );
}
dXSARGS;
dORIGMARK;
HV *oldstash = curstash;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
SP -= items;
dORIGMARK;
HV *oldstash = curstash;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
/* SP -= items; added by xsubpp */
DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
dowarn = warn_tmp;
}
- Sub = GvSV(DBsub); /* name of current sub */
sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
{
package Devel::Peek;
-$VERSION = $VERSION = 0.95;
+$VERSION = 0.95;
require Exporter;
-require DynaLoader;
+use XSLoader ();
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg);
@EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec);
%EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]);
-bootstrap Devel::Peek;
+XSLoader::load 'Devel::Peek';
sub DumpWithOP ($;$) {
local($Devel::Peek::dump_ops)=1;
XSUB = 0x0
XSUBANY = 0
GVGV::GV = 0x1d44e8 "MY" :: "top_targets"
- FILEGV = 0x1fab74 "_<(eval 5)"
+ FILE = "(eval 5)"
DEPTH = 0
PADLIST = 0x1c9338
PL_dumpindent = 2;
for (i=1; i<items; i++) {
- PerlIO_printf(Perl_debug_log, "Elt No. %ld 0x%lx\n", i - 1, ST(i));
+ PerlIO_printf(Perl_debug_log, "Elt No. %ld 0x%"UVxf"\n", i - 1, PTR2UV(ST(i)));
do_sv_dump(0, Perl_debug_log, ST(i), 0, lim, dumpop && SvTRUE(dumpop), pv_lim);
}
PL_dumpindent = save_dumpindent;
sub to_string {
my ($value) = @_;
- $value =~ s/\\/\\\\'/g;
+ $value =~ s/\\/\\\\/g;
$value =~ s/'/\\'/g;
return "'$value'";
}
#
# Tim.Bunce@ig.co.uk, August 1994
-$VERSION = $VERSION = "1.03"; # avoid typo warning
+$VERSION = "1.03"; # avoid typo warning
require AutoLoader;
*AUTOLOAD = \&AutoLoader::AUTOLOAD;
# See dl_expandspec() for more details. Should be harmless but
# inefficient to define on systems that don't need it.
$do_expand = $Is_VMS = $^O eq 'VMS';
+$Is_MacOS = $^O eq 'MacOS';
@dl_require_symbols = (); # names of symbols we need
@dl_resolve_using = (); # names of files to link with
# Add to @dl_library_path any extra directories we can gather
# from environment variables.
-push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
- if exists $Config::Config{ldlibpthname} &&
- $Config::Config{ldlibpthname} ne '' &&
- exists $ENV{$Config::Config{ldlibpthname}} ;;
+if ($Is_MacOS) {
+ push(@dl_library_path, split(/,/, $ENV{LD_LIBRARY_PATH}))
+ if exists $ENV{LD_LIBRARY_PATH};
+} else {
+ push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
+ if exists $Config::Config{ldlibpthname} &&
+ $Config::Config{ldlibpthname} ne '' &&
+ exists $ENV{$Config::Config{ldlibpthname}} ;;
+ push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
+ if exists $Config::Config{ldlibpthname} &&
+ $Config::Config{ldlibpthname} ne '' &&
+ exists $ENV{$Config::Config{ldlibpthname}} ;;
# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH.
push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH}))
if exists $ENV{LD_LIBRARY_PATH};
+}
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
sub croak { require Carp; Carp::croak(@_) }
+sub bootstrap_inherit {
+ my $module = $_[0];
+ local *isa = *{"$module\::ISA"};
+ local @isa = (@isa, 'DynaLoader');
+ # Cannot goto due to delocalization. Will report errors on a wrong line?
+ bootstrap(@_);
+}
+
# The bootstrap function cannot be autoloaded (without complications)
# so we define it here:
# It may also edit @modparts if required.
$modfname = &mod2fname(\@modparts) if defined &mod2fname;
- my $modpname = join('/',@modparts);
+ my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts);
print STDERR "DynaLoader::bootstrap for $module ",
- "(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug;
+ ($Is_MacOS
+ ? "(auto/$modpname/$modfname.$dl_dlext)\n" :
+ "(:auto:$modpname:$modfname.$dl_dlext)\n")
+ if $dl_debug;
foreach (@INC) {
chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;
- my $dir = "$_/auto/$modpname";
+ my $dir;
+ if ($Is_MacOS) {
+ chop $_ if /:$/;
+ $dir = "$_:auto:$modpname";
+ } else {
+ $dir = "$_/auto/$modpname";
+ }
next unless -d $dir; # skip over uninteresting directories
# check for common cases to avoid autoload of dl_findfile
- my $try = "$dir/$modfname.$dl_dlext";
+ my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try);
# no luck here, save dir for possible later dl_findfile search
last arg unless wantarray;
next;
}
+ elsif ($Is_MacOS) {
+ if (m/:/ && -f $_) {
+ push(@found,$_);
+ last arg unless wantarray;
+ }
+ }
elsif (m:/: && -f $_ && !$do_expand) {
push(@found,$_);
last arg unless wantarray;
# Using a -L prefix is the preferred option (faster and more robust)
if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+ if ($Is_MacOS) {
+ # Otherwise we try to try to spot directories by a heuristic
+ # (this is a more complicated issue than it first appears)
+ if (m/:/ && -d $_) { push(@dirs, $_); next; }
+ # Only files should get this far...
+ my(@names, $name); # what filenames to look for
+ s/^-l//;
+ push(@names, $_);
+ foreach $dir (@dirs, @dl_library_path) {
+ next unless -d $dir;
+ $dir =~ s/^([^:]+)$/:$1/;
+ $dir =~ s/:$//;
+ foreach $name (@names) {
+ my($file) = "$dir:$name";
+ print STDERR " checking in $dir for $name\n" if $dl_debug;
+ if (-f $file) {
+ push(@found, $file);
+ next arg; # no need to look any further
+ }
+ }
+ }
+ next;
+ }
+
# Otherwise we try to try to spot directories by a heuristic
# (this is a more complicated issue than it first appears)
if (m:/: && -d $_) { push(@dirs, $_); next; }
SKIP => [qw(dynamic dynamic_lib dynamic_bs)],
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'DynaLoader_pm.PL',
- PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm'},
- PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'},
+ PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm',
+ 'XSLoader_pm.PL'=>'XSLoader.pm'},
+ PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm',
+ 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'},
clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'},
);
--- /dev/null
+use Config;
+
+sub to_string {
+ my ($value) = @_;
+ $value =~ s/\\/\\\\/g;
+ $value =~ s/'/\\'/g;
+ return "'$value'";
+}
+
+unlink "XSLoader.pm" if -f "XSLoader.pm";
+open OUT, ">XSLoader.pm" or die $!;
+print OUT <<'EOT';
+# Generated from XSLoader.pm.PL (resolved %Config::Config value)
+
+package XSLoader;
+
+# And Gandalf said: 'Many folk like to know beforehand what is to
+# be set on the table; but those who have laboured to prepare the
+# feast like to keep their secret; for wonder makes the words of
+# praise louder.'
+
+# (Quote from Tolkien sugested by Anno Siegel.)
+#
+# See pod text at end of file for documentation.
+# See also ext/DynaLoader/README in source tree for other information.
+#
+# Tim.Bunce@ig.co.uk, August 1994
+
+$VERSION = "0.01"; # avoid typo warning
+
+# enable debug/trace messages from DynaLoader perl code
+# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+
+EOT
+
+print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
+
+print OUT <<'EOT';
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+package DynaLoader;
+boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
+ !defined(&dl_load_file);
+package XSLoader;
+
+1; # End of main code
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub load {
+ package DynaLoader;
+
+ my($module) = $_[0];
+
+ # work with static linking too
+ my $b = "$module\::bootstrap";
+ goto &$b if defined &$b;
+
+ goto retry unless $module and defined &dl_load_file;
+
+ my @modparts = split(/::/,$module);
+ my $modfname = $modparts[-1];
+
+EOT
+
+print OUT <<'EOT' if defined &DynaLoader::mod2fname;
+ # Some systems have restrictions on files names for DLL's etc.
+ # mod2fname returns appropriate file base name (typically truncated)
+ # It may also edit @modparts if required.
+ $modfname = &mod2fname(\@modparts) if defined &mod2fname;
+
+EOT
+
+print OUT <<'EOT';
+ my $modpname = join('/',@modparts);
+ my $modlibname = (caller())[1];
+ my $c = @modparts;
+ $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
+ my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
+
+# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
+
+ my $bs = $file;
+ $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
+
+ goto retry if not -f $file or -s $bs;
+
+ my $bootname = "boot_$module";
+ $bootname =~ s/\W/_/g;
+ @dl_require_symbols = ($bootname);
+
+ # Many dynamic extension loading problems will appear to come from
+ # this section of code: XYZ failed at line 123 of DynaLoader.pm.
+ # Often these errors are actually occurring in the initialisation
+ # C code of the extension XS file. Perl reports the error as being
+ # in this perl code simply because this was the last perl code
+ # it executed.
+
+ my $libref = dl_load_file($file, 0) or do {
+ require Carp;
+ Carp::croak("Can't load '$file' for module $module: " . dl_error());
+ };
+ push(@dl_librefs,$libref); # record loaded object
+
+ my @unresolved = dl_undef_symbols();
+ if (@unresolved) {
+ require Carp;
+ Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+ }
+
+ my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
+ require Carp;
+ Carp::croak("Can't find '$bootname' symbol in $file\n");
+ };
+
+ my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+ push(@dl_modules, $module); # record loaded module
+
+ # See comment block above
+ return &$xs(@_);
+
+ retry:
+ require DynaLoader;
+ goto &DynaLoader::bootstrap_inherit;
+}
+
+__END__
+
+=head1 NAME
+
+XSLoader - Dynamically load C libraries into Perl code
+
+=head1 SYNOPSIS
+
+ package YourPackage;
+ use XSLoader;
+
+ XSLoader::load 'YourPackage', @args;
+
+=head1 DESCRIPTION
+
+This module defines a standard I<simplified> interface to the dynamic
+linking mechanisms available on many platforms. Its primary purpose is
+to implement cheap automatic dynamic loading of Perl modules.
+
+For more complicated interface see L<DynaLoader>.
+
+=head1 AUTHOR
+
+Ilya Zakharevich: extraction from DynaLoader.
+
+=cut
+EOT
+
+close OUT or die $!;
+
{
char *perl_dl_nonlazy;
#ifdef DEBUGGING
- dl_debug = SvIV(get_sv("DynaLoader::dl_debug", 0x04) );
+ SV *sv = get_sv("DynaLoader::dl_debug", 0);
+ dl_debug = sv ? SvIV(sv) : 0;
#endif
if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
dl_nonlazy = atoi(perl_dl_nonlazy);
sub process_file {
my($file) = @_;
- return unless defined $file;
+ return unless defined $file and -f $file;
local *FH;
if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
use Config;
use strict;
-\$Config{'myarchname'} eq "$Config{'myarchname'}" or
- die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})";
+"\$Config{'archname'}-\$Config{'osvers'}" eq
+"$Config{'archname'}-$Config{'osvers'}" or
+ die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})";
\$VERSION = "$VERSION";
\@ISA = qw(Exporter);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Exporter);
$VERSION = "1.03";
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
O_TEXT
O_TRUNC
O_WRONLY
+ O_ALIAS
+ O_RSRC
SEEK_SET
SEEK_CUR
SEEK_END
goto &$AUTOLOAD;
}
-bootstrap Fcntl $VERSION;
+XSLoader::load 'Fcntl', $VERSION;
1;
#else
goto not_there;
#endif
+ if (strEQ(name, "O_ALIAS"))
+#ifdef O_ALIAS
+ return O_ALIAS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "O_RSRC"))
+#ifdef O_RSRC
+ return O_RSRC;
+#else
+ goto not_there;
+#endif
} else
goto not_there;
break;
- ansified prototypes
- s/struct stat/Stat_t/
- split on spaces to make <*.c *.h> work (for compatibility)
+0.991 Tue Oct 26 09:48:00 BST 1999
+ - Add case-insensitive matching (GLOB_NOCASE)
+ - Make glob_csh case insensitive by default on Win32, VMS,
+ OS/2, DOS, RISC OS, and Mac OS
+ - Add support for :case and :nocase tags
+ - Hack to make patterns like C:* work on DOSISH systems
+ - Add support for either \ or / as separators on DOSISH systems
+ - Limit effect of \ as a quoting operator on DOSISH systems to
+ when it precedes one of []{}-~\ (to minimise backslashitis).
use strict;
use Carp;
-use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS $AUTOLOAD);
+use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL
+ %EXPORT_TAGS $AUTOLOAD $DEFAULT_FLAGS);
require Exporter;
-require DynaLoader;
+use XSLoader ();
require AutoLoader;
-@ISA = qw(Exporter DynaLoader AutoLoader);
+@ISA = qw(Exporter AutoLoader);
@EXPORT_OK = qw(
- globally
csh_glob
glob
GLOB_ABEND
GLOB_ALTDIRFUNC
GLOB_BRACE
+ GLOB_CSH
GLOB_ERR
GLOB_ERROR
GLOB_MARK
+ GLOB_NOCASE
GLOB_NOCHECK
GLOB_NOMAGIC
GLOB_NOSORT
GLOB_TILDE
);
-@EXPORT_FAIL = ( 'globally' );
-
%EXPORT_TAGS = (
'glob' => [ qw(
GLOB_ABEND
GLOB_ALTDIRFUNC
GLOB_BRACE
+ GLOB_CSH
GLOB_ERR
GLOB_ERROR
GLOB_MARK
+ GLOB_NOCASE
GLOB_NOCHECK
GLOB_NOMAGIC
GLOB_NOSORT
) ],
);
-$VERSION = '0.99';
-
-sub export_fail {
- shift;
-
- if ($_[0] eq 'globally') {
- local $^W;
- *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
- shift;
+$VERSION = '0.991';
+
+sub import {
+ my $i = 1;
+ while ($i < @_) {
+ if ($_[$i] =~ /^:(case|nocase|globally)$/) {
+ splice(@_, $i, 1);
+ $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
+ $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
+ if ($1 eq 'globally') {
+ local $^W;
+ *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
+ }
+ next;
+ }
+ ++$i;
}
-
- @_;
+ goto &Exporter::import;
}
sub AUTOLOAD {
goto &$AUTOLOAD;
}
-bootstrap File::Glob $VERSION;
+XSLoader::load 'File::Glob', $VERSION;
# Preloaded methods go here.
sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() }
+$DEFAULT_FLAGS = GLOB_CSH();
+if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
+ $DEFAULT_FLAGS |= GLOB_NOCASE();
+}
+
# Autoload methods go after =cut, and are processed by the autosplit program.
sub glob {
# if we're just beginning, do it all first
if ($iter{$cxix} == 0) {
if (@pat) {
- $entries{$cxix} = [ map { doglob($_, GLOB_CSH) } @pat ];
+ $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
}
else {
- $entries{$cxix} = [ doglob($pat, GLOB_CSH) ];
+ $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
}
}
}
## override the core glob (even with -T)
- use File::Glob 'globally';
+ use File::Glob ':globally';
+ my @sources = <*.{c,h,y}>
+
+ ## override the core glob, forcing case sensitivity
+ use File::Glob qw(:globally :case);
+ my @sources = <*.{c,h,y}>
+
+ ## override the core glob forcing case insensitivity
+ use File::Glob qw(:globally :nocase);
my @sources = <*.{c,h,y}>
=head1 DESCRIPTION
Each pathname that is a directory that matches the pattern has a slash
appended.
+=item C<GLOB_NOCASE>
+
+By default, file names are assumed to be case sensitive; this flag
+makes glob() treat case differences as not significant.
+
=item C<GLOB_NOCHECK>
If the pattern does not match any pathname, then glob() returns a list
Use the backslash ('\') character for quoting: every occurrence of a
backslash followed by a character in the pattern is replaced by that
character, avoiding any special interpretation of the character.
+(But see below for exceptions on DOSISH systems).
=item C<GLOB_TILDE>
=item *
+On DOSISH systems, backslash is a valid directory separator character.
+In this case, use of backslash as a quoting character (via GLOB_QUOTE)
+interferes with the use of backslash as a directory separator. The
+best (simplest, most portable) solution is to use forward slashes for
+directory separators, and backslashes for quoting. However, this does
+not match "normal practice" on these systems. As a concession to user
+expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
+glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
+All other backslashes are passed through unchanged.
+
+=item *
+
Win32 users should use the real slash. If you really want to use
backslashes, consider using Sarathy's File::DosGlob, which comes with
the standard Perl distribution.
=head1 AUTHOR
-The Perl interface was written by Nathan Torkington (gnat@frii.com),
+The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
and is released under the artistic license. Further modifications were
made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt> and Gurusamy Sarathy
E<lt>gsar@activestate.comE<gt>. The C glob code has the
following copyright:
- Copyright (c) 1989, 1993 The Regents of the University of California.
- All rights reserved. This code is derived from software contributed
- to Berkeley by Guido van Rossum.
-
-For redistribution of the C glob code, read the copyright notice in
-the file bsd_glob.c, which is part of the File::Glob source distribution.
+ Copyright (c) 1989, 1993 The Regents of the University of California.
+ All rights reserved.
+
+ This code is derived from software contributed to Berkeley by
+ Guido van Rossum.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. Neither the name of the University nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
=cut
#endif
break;
case 'N':
+ if (strEQ(name, "GLOB_NOCASE"))
+#ifdef GLOB_NOCASE
+ return GLOB_NOCASE;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "GLOB_NOCHECK"))
#ifdef GLOB_NOCHECK
return GLOB_NOCHECK;
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
- * 3. All advertising materials mentioning features or use of this software
- * must display the following acknowledgement:
- * This product includes software developed by the University of
- * California, Berkeley and its contributors.
- * 4. Neither the name of the University nor the names of its contributors
+ * 3. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* SUCH DAMAGE.
*/
-/*
- * Clause 3 above should be considered "deleted in its entirety".
- * For the actual notice of withdrawal, see:
- * ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change
- */
-
#if defined(LIBC_SCCS) && !defined(lint)
static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93";
#endif /* LIBC_SCCS and not lint */
#define BG_RANGE '-'
#define BG_RBRACKET ']'
#define BG_SEP '/'
+#ifdef DOSISH
+#define BG_SEP2 '\\'
+#endif
#define BG_STAR '*'
#define BG_TILDE '~'
#define BG_UNDERSCORE '_'
static int compare(const void *, const void *);
+static int ci_compare(const void *, const void *);
static void g_Ctoc(const Char *, char *);
static int g_lstat(Char *, Stat_t *, glob_t *);
static DIR *g_opendir(Char *, glob_t *);
static const Char * globtilde(const Char *, Char *, glob_t *);
static int globexp1(const Char *, glob_t *);
static int globexp2(const Char *, const Char *, glob_t *, int *);
-static int match(Char *, Char *, Char *);
+static int match(Char *, Char *, Char *, int);
#ifdef GLOB_DEBUG
static void qprintf(const char *, Char *);
#endif /* GLOB_DEBUG */
bufnext = patbuf;
bufend = bufnext + MAXPATHLEN;
+#ifdef DOSISH
+ /* Nasty hack to treat patterns like "C:*" correctly. In this
+ * case, the * should match any file in the current directory
+ * on the C: drive. However, the glob code does not treat the
+ * colon specially, so it looks for files beginning "C:" in
+ * the current directory. To fix this, change the pattern to
+ * add an explicit "./" at the start (just after the drive
+ * letter and colon - ie change to "C:./*").
+ */
+ if (isalpha(pattern[0]) && pattern[1] == ':' &&
+ pattern[2] != BG_SEP && pattern[2] != BG_SEP2 &&
+ bufend - bufnext > 4) {
+ *bufnext++ = pattern[0];
+ *bufnext++ = ':';
+ *bufnext++ = '.';
+ *bufnext++ = BG_SEP;
+ patnext += 2;
+ }
+#endif
if (flags & GLOB_QUOTE) {
/* Protect the quoted characters. */
while (bufnext < bufend && (c = *patnext++) != BG_EOS)
if (c == BG_QUOTE) {
+#ifdef DOSISH
+ /* To avoid backslashitis on Win32,
+ * we only treat \ as a quoting character
+ * if it precedes one of the
+ * metacharacters []-{}~\
+ */
+ if ((c = *patnext++) != '[' && c != ']' &&
+ c != '-' && c != '{' && c != '}' &&
+ c != '~' && c != '\\') {
+#else
if ((c = *patnext++) == BG_EOS) {
+#endif
c = BG_QUOTE;
--patnext;
}
}
else if (!(pglob->gl_flags & GLOB_NOSORT))
qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc,
- pglob->gl_pathc - oldpathc, sizeof(char *), compare);
+ pglob->gl_pathc - oldpathc, sizeof(char *),
+ (pglob->gl_flags & GLOB_NOCASE) ? ci_compare : compare);
pglob->gl_flags = oldflags;
return(0);
}
static int
+ci_compare(const void *p, const void *q)
+{
+ const char *pp = *(const char **)p;
+ const char *qq = *(const char **)q;
+ while (*pp && *qq) {
+ if (tolower(*pp) != tolower(*qq))
+ break;
+ ++pp;
+ ++qq;
+ }
+ return (tolower(*pp) - tolower(*qq));
+}
+
+static int
compare(const void *p, const void *q)
{
return(strcmp(*(char **)p, *(char **)q));
return(0);
if (((pglob->gl_flags & GLOB_MARK) &&
- pathend[-1] != BG_SEP) && (S_ISDIR(sb.st_mode)
+ pathend[-1] != BG_SEP
+#ifdef DOSISH
+ && pathend[-1] != BG_SEP2
+#endif
+ ) && (S_ISDIR(sb.st_mode)
|| (S_ISLNK(sb.st_mode) &&
(g_stat(pathbuf, &sb, pglob) == 0) &&
S_ISDIR(sb.st_mode)))) {
/* Find end of next segment, copy tentatively to pathend. */
q = pathend;
p = pattern;
- while (*p != BG_EOS && *p != BG_SEP) {
+ while (*p != BG_EOS && *p != BG_SEP
+#ifdef DOSISH
+ && *p != BG_SEP2
+#endif
+ ) {
if (ismeta(*p))
anymeta = 1;
*q++ = *p++;
if (!anymeta) { /* No expansion, do next segment. */
pathend = q;
pattern = p;
- while (*pattern == BG_SEP)
+ while (*pattern == BG_SEP
+#ifdef DOSISH
+ || *pattern == BG_SEP2
+#endif
+ )
*pathend++ = *pattern++;
} else /* Need expansion, recurse. */
return(glob3(pathbuf, pathend, pattern, p, pglob));
register Direntry_t *dp;
DIR *dirp;
int err;
+ int nocase;
char buf[MAXPATHLEN];
/*
}
err = 0;
+ nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0);
/* Search directory for matching names. */
if (pglob->gl_flags & GLOB_ALTDIRFUNC)
for (sc = (U8 *) dp->d_name, dc = pathend;
(*dc++ = *sc++) != BG_EOS;)
continue;
- if (!match(pathend, pattern, restpattern)) {
+ if (!match(pathend, pattern, restpattern, nocase)) {
*pathend = BG_EOS;
continue;
}
* pattern causes a recursion level.
*/
static int
-match(register Char *name, register Char *pat, register Char *patend)
+match(register Char *name, register Char *pat, register Char *patend, int nocase)
{
int ok, negate_range;
Char c, k;
if (pat == patend)
return(1);
do
- if (match(name, pat, patend))
+ if (match(name, pat, patend, nocase))
return(1);
while (*name++ != BG_EOS);
return(0);
++pat;
while (((c = *pat++) & M_MASK) != M_END)
if ((*pat & M_MASK) == M_RNG) {
- if (c <= k && k <= pat[1])
- ok = 1;
+ if (nocase) {
+ if (tolower(c) <= tolower(k) && tolower(k) <= tolower(pat[1]))
+ ok = 1;
+ } else {
+ if (c <= k && k <= pat[1])
+ ok = 1;
+ }
pat += 2;
- } else if (c == k)
+ } else if (nocase ? (tolower(c) == tolower(k)) : (c == k))
ok = 1;
if (ok == negate_range)
return(0);
break;
default:
- if (*name++ != c)
+ k = *name++;
+ if (nocase ? (tolower(k) != tolower(c)) : (k != c))
return(0);
break;
}
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
- * 3. All advertising materials mentioning features or use of this software
- * must display the following acknowledgement:
- * This product includes software developed by the University of
- * California, Berkeley and its contributors.
- * 4. Neither the name of the University nor the names of its contributors
+ * 3. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* @(#)glob.h 8.1 (Berkeley) 6/2/93
*/
-/*
- * Clause 3 above should be considered "deleted in its entirety".
- * For the actual notice of withdrawal, see:
- * ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change
- */
-
#ifndef _BSD_GLOB_H_
#define _BSD_GLOB_H_
#define GLOB_NOMAGIC 0x0200 /* GLOB_NOCHECK without magic chars (csh). */
#define GLOB_QUOTE 0x0400 /* Quote special chars with \. */
#define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */
+#define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */
#define GLOB_NOSPACE (-1) /* Malloc call failed. */
#define GLOB_ABEND (-2) /* Unignored error. */
require Tie::Hash;
require Exporter;
use AutoLoader;
-require DynaLoader;
-@ISA = qw(Tie::Hash Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Tie::Hash Exporter);
@EXPORT = qw(
GDBM_CACHESIZE
GDBM_FAST
goto &$AUTOLOAD;
}
-bootstrap GDBM_File $VERSION;
+XSLoader::load 'GDBM_File', $VERSION;
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
package IO;
-require DynaLoader;
-require Exporter;
+use XSLoader ();
use Carp;
-use vars qw(@ISA $VERSION @EXPORT);
-
-@ISA = qw(DynaLoader);
$VERSION = "1.20";
-bootstrap IO $VERSION;
+XSLoader::load 'IO', $VERSION;
sub import {
shift;
int type
int size
CODE:
-/* Should check HAS_SETVBUF once Configure tests for that */
-#if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
if (!handle) /* Try input stream. */
handle = IoIFP(sv_2io(ST(0)));
if (handle)
sub exists
{
my $vec = shift;
- $vec->[$vec->_fileno(shift) + FIRST_FD];
+ my $fno = $vec->_fileno(shift);
+ return undef unless defined $fno;
+ $vec->[$fno + FIRST_FD];
}
}
$peer = accept($new,$sock) || undef;
};
+ croak "$@" if $@ and $sock;
return wantarray ? defined $peer ? ($new, $peer)
: ()
use vars qw($VERSION @ISA);
require Tie::Hash;
-require DynaLoader;
+use DynaLoader ();
-@ISA = qw(Tie::Hash DynaLoader);
+@ISA = qw(Tie::Hash);
$VERSION = "1.03";
-bootstrap NDBM_File $VERSION;
+XSLoader::load 'NDBM_File', $VERSION;
1;
use vars qw($VERSION @ISA);
require Tie::Hash;
-require DynaLoader;
+use DynaLoader ();
-@ISA = qw(Tie::Hash DynaLoader);
+@ISA = qw(Tie::Hash);
$VERSION = "1.02";
-bootstrap ODBM_File $VERSION;
+XSLoader::load 'ODBM_File', $VERSION;
1;
use strict;
use Carp;
use Exporter ();
-use DynaLoader ();
-@ISA = qw(Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Exporter);
BEGIN {
@EXPORT_OK = qw(
sub opdump (;$);
use subs @EXPORT_OK;
-bootstrap Opcode $XS_VERSION;
+XSLoader::load 'Opcode', $XS_VERSION;
_init_optags();
opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
{
char *orig_op_mask = PL_op_mask;
- SAVEPPTR(PL_op_mask);
+ SAVEVPTR(PL_op_mask);
#if !defined(PERL_OBJECT)
/* XXX casting to an ordinary function ptr from a member function ptr
* is disallowed by Borland
save_hptr(&PL_defstash); /* save current default stack */
/* the assignment to global defstash changes our sense of 'main' */
PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */
+ save_hptr(&PL_curstash);
+ PL_curstash = PL_defstash;
/* defstash must itself contain a main:: so we'll add that now */
/* take care with the ref counts (was cause of long standing bug) */
use Symbol;
require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Exporter);
-$VERSION = $VERSION = "1.03" ;
+$VERSION = "1.03" ;
%EXPORT_TAGS = (
}
-bootstrap POSIX $VERSION;
+XSLoader::load 'POSIX', $VERSION;
my $EINVAL = constant("EINVAL", 0);
my $EAGAIN = constant("EAGAIN", 0);
# This code is really grody because we're trying to make the signal
# interface look beautiful, which is hard.
- if (!PL_siggv)
- gv_fetchpv("SIG", TRUE, SVt_PVHV);
-
{
+ GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
struct sigaction oact;
POSIX__SigSet sigset;
SV** svp;
- SV** sigsvp = hv_fetch(GvHVn(PL_siggv),
+ SV** sigsvp = hv_fetch(GvHVn(siggv),
PL_sig_name[sig],
strlen(PL_sig_name[sig]),
TRUE);
);
sub MY::postamble {
- if ($^O ne 'VMS') {
+ if ($^O =~ /MSWin32/ && Win32::IsWin95()) {
+ # XXX: dmake-specific, like rest of Win95 port
+ return
+ '
+$(MYEXTLIB): sdbm/Makefile
+@[
+ cd sdbm
+ $(MAKE) all
+ cd ..
+]
+';
+ }
+ elsif ($^O ne 'VMS') {
'
$(MYEXTLIB): sdbm/Makefile
cd sdbm && $(MAKE) all
';
- } else {
- '
+ }
+ else {
+ '
$(MYEXTLIB) : [.sdbm]descrip.mms
set def [.sdbm]
$(MMS) all
use vars qw($VERSION @ISA);
require Tie::Hash;
-require DynaLoader;
+use XSLoader ();
-@ISA = qw(Tie::Hash DynaLoader);
+@ISA = qw(Tie::Hash);
$VERSION = "1.02" ;
-bootstrap SDBM_File $VERSION;
+XSLoader::load 'SDBM_File', $VERSION;
1;
use Carp;
require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use XSLoader ();
+@ISA = qw(Exporter);
@EXPORT = qw(
inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in
pack_sockaddr_un unpack_sockaddr_un
goto &$AUTOLOAD;
}
-bootstrap Socket $VERSION;
+XSLoader::load 'Socket', $VERSION;
1;
package Thread;
require Exporter;
-require DynaLoader;
+use XSLoader ();
use vars qw($VERSION @ISA @EXPORT);
$VERSION = "1.0";
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
=head1 NAME
return eval { shift->join; };
}
-bootstrap Thread;
+XSLoader::load 'Thread';
1;
package attrs;
-require DynaLoader;
-use vars '@ISA';
-@ISA = 'DynaLoader';
+use XSLoader ();
-use vars qw($VERSION);
$VERSION = "1.0";
=head1 NAME
=cut
-bootstrap attrs $VERSION;
+XSLoader::load 'attrs', $VERSION;
1;
foreach my $s (@_){
if ($s eq 'debug' or $s eq 'debugcolor') {
setcolor() if $s eq 'debugcolor';
- require DynaLoader;
- @ISA = ('DynaLoader');
- bootstrap re;
+ require XSLoader;
+ XSLoader::load('re');
install() if $on;
uninstall() unless $on;
next;
# and run 'make regen_headers' to effect changes.
#
+perl_alloc_using
+perl_alloc
+perl_construct
+perl_destruct
+perl_free
+perl_run
+perl_parse
+perl_clone
+perl_clone_using
+Perl_malloc
+Perl_calloc
+Perl_realloc
+Perl_mfree
+Perl_malloced_size
Perl_amagic_call
Perl_Gv_AMupdate
Perl_append_elem
Perl_cxinc
Perl_deb
Perl_vdeb
-Perl_deb_growlevel
Perl_debprofdump
Perl_debop
Perl_debstack
Perl_magic_sizepack
Perl_magic_wipepack
Perl_magicname
-Perl_malloced_size
Perl_markstack_grow
Perl_mem_collxfrm
Perl_mess
Perl_newHVhv
Perl_newIO
Perl_newLISTOP
+Perl_newPADOP
Perl_newPMOP
Perl_newPVOP
Perl_newRV
Perl_pad_reset
Perl_pad_swipe
Perl_peep
-perl_construct
-perl_destruct
-perl_free
-perl_run
-perl_parse
-perl_alloc
-perl_construct
-perl_destruct
-perl_free
-perl_run
-perl_parse
Perl_new_struct_thread
Perl_call_atexit
Perl_call_argv
Perl_save_hptr
Perl_save_I16
Perl_save_I32
+Perl_save_I8
Perl_save_int
Perl_save_item
Perl_save_iv
Perl_save_op
Perl_save_scalar
Perl_save_pptr
+Perl_save_vptr
Perl_save_re_context
Perl_save_sptr
Perl_save_svref
Perl_vivify_defelem
Perl_vivify_ref
Perl_wait4pid
+Perl_report_uninit
Perl_warn
Perl_vwarn
Perl_warner
Perl_yyparse
Perl_yywarn
Perl_dump_mstats
-Perl_malloc
-Perl_calloc
-Perl_realloc
-Perl_mfree
Perl_safesysmalloc
Perl_safesyscalloc
Perl_safesysrealloc
Perl_newMYSUB
Perl_my_attrs
Perl_boot_core_xsutils
+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_sys_intern_dup
+Perl_ptr_table_new
+Perl_ptr_table_fetch
+Perl_ptr_table_store
+Perl_ptr_table_split
#undef PERLVARA
#define PERLVARA(x, n, y)
#undef PERLVARI
-#define PERLVARI(x, y, z) PL_##x = z;
+#define PERLVARI(x, y, z) interp.x = z;
#undef PERLVARIC
-#define PERLVARIC(x, y, z) PL_##x = z;
+#define PERLVARIC(x, y, z) interp.x = z;
-CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
+CPerlObj::CPerlObj(IPerlMem* ipM, IPerlMem* ipMS, IPerlMem* ipMP,
+ IPerlEnv* ipE, IPerlStdIO* ipStd,
IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS,
IPerlProc* ipP)
{
#include "thrdvar.h"
#include "intrpvar.h"
-#include "perlvars.h"
PL_Mem = ipM;
+ PL_MemShared = ipMS;
+ PL_MemParse = ipMP;
PL_Env = ipE;
PL_StdIO = ipStd;
PL_LIO = ipLIO;
{
if(pvtbl)
return pvtbl->pMalloc(pvtbl, nSize);
-
+#ifndef __MINGW32__
+ /* operator new is supposed to throw std::bad_alloc */
return NULL;
+#endif
}
void
pvtbl->pFree(pvtbl, pPerl);
}
-void
-CPerlObj::Init(void)
-{
-}
-
#ifdef WIN32 /* XXX why are these needed? */
bool
Perl_do_exec(char *cmd)
ppaddr
sig_name
sig_num
-psig_name
-psig_ptr
regkind
simple
utf8skip
STRLEN tmplen;
GV *gv;
+ if (!PL_defstash)
+ return Nullgv;
+
tmplen = strlen(name) + 2;
if (tmplen < sizeof smallbuf)
tmpbuf = smallbuf;
tmpbuf[1] = '<';
strcpy(tmpbuf + 2, name);
gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
- if (!isGV(gv))
+ if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
+ sv_setpv(GvSV(gv), name);
+ if (PERLDB_LINE)
+ hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
+ }
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
- sv_setpv(GvSV(gv), name);
- if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
- GvMULTI_on(gv);
- if (PERLDB_LINE)
- hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
return gv;
}
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
- GvLINE(gv) = PL_curcop->cop_line;
- GvFILEGV(gv) = PL_curcop->cop_filegv;
+ GvLINE(gv) = CopLINE(PL_curcop);
+ GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
sv_magic((SV*)gv, (SV*)gv, '*', name, len);
PL_sub_generation++;
CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv;
+ CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(GvCV(gv)) = 0;
if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
- HvNAME(PL_curcop->cop_stash)));
+ CopSTASHPV(PL_curcop)));
stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvNAME(stash), name) );
name++;
for (namend = name; *namend; namend++) {
- if ((*namend == '\'' && namend[1]) ||
- (*namend == ':' && namend[1] == ':'))
+ if ((*namend == ':' && namend[1] == ':')
+ || (*namend == '\'' && namend[1]))
{
if (!stash)
stash = PL_defstash;
}
}
else
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
else
stash = PL_defstash;
if (strEQ(name, "SIG")) {
HV *hv;
I32 i;
- PL_siggv = gv;
- GvMULTI_on(PL_siggv);
- hv = GvHVn(PL_siggv);
- hv_magic(hv, PL_siggv, 'S');
- for(i=1;PL_sig_name[i];i++) {
+ if (!PL_psig_ptr) {
+ int sig_num[] = { SIG_NUM };
+ New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ }
+ GvMULTI_on(gv);
+ hv = GvHVn(gv);
+ hv_magic(hv, gv, 'S');
+ for (i = 1; PL_sig_name[i]; i++) {
SV ** init;
- init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1);
- if(init)
- sv_setsv(*init,&PL_sv_undef);
+ init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
+ if (init)
+ sv_setsv(*init, &PL_sv_undef);
PL_psig_ptr[i] = 0;
PL_psig_name[i] = 0;
}
case '&':
if (len > 1)
break;
- PL_ampergv = gv;
PL_sawampersand = TRUE;
goto ro_magicalize;
case '`':
if (len > 1)
break;
- PL_leftgv = gv;
PL_sawampersand = TRUE;
goto ro_magicalize;
case '\'':
if (len > 1)
break;
- PL_rightgv = gv;
PL_sawampersand = TRUE;
goto ro_magicalize;
register I32 i;
register GV *gv;
HV *hv;
- GV *filegv;
if (!HvARRAY(stash))
return;
gv_check(hv); /* nested package */
}
else if (isALPHA(*HeKEY(entry))) {
+ char *file;
gv = (GV*)HeVAL(entry);
if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
continue;
- PL_curcop->cop_line = GvLINE(gv);
- filegv = GvFILEGV(gv);
- PL_curcop->cop_filegv = filegv;
- if (filegv && GvMULTI(filegv)) /* Filename began with slash */
+ file = GvFILE(gv);
+ /* performance hack: if filename is absolute and it's a standard
+ * module, don't bother warning */
+ if (file
+ && PERL_FILE_IS_ABSOLUTE(file)
+ && (instr(file, "/lib/") || instr(file, ".pm")))
+ {
continue;
+ }
+ CopLINE_set(PL_curcop, GvLINE(gv));
+#ifdef USE_ITHREADS
+ CopFILE(PL_curcop) = file; /* set for warning */
+#else
+ CopFILEGV(PL_curcop) = gv_fetchfile(file);
+#endif
Perl_warner(aTHX_ WARN_ONCE,
"Name \"%s::%s\" used only once: possible typo",
HvNAME(stash), GvNAME(gv));
GP*
Perl_gp_ref(pTHX_ GP *gp)
{
+ if (!gp)
+ return (GP*)NULL;
gp->gp_refcnt++;
if (gp->gp_cv) {
if (gp->gp_cvgen) {
GV * gp_egv; /* effective gv, if *glob */
CV * gp_cv; /* subroutine value */
U32 gp_cvgen; /* generational validity of cached gv_cv */
- I32 gp_lastexpr; /* used by nothing_in_common() */
+ U32 gp_flags; /* XXX unused */
line_t gp_line; /* line first declared at (for -w) */
- GV * gp_filegv; /* file first declared in (for -w) */
+ char * gp_file; /* file first declared in (for -w) */
};
#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen)
#define GvCVu(gv) (GvGP(gv)->gp_cvgen ? Nullcv : GvGP(gv)->gp_cv)
-#define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr)
+#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags)
#define GvLINE(gv) (GvGP(gv)->gp_line)
-#define GvFILEGV(gv) (GvGP(gv)->gp_filegv)
+#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 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 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)
+
#define Nullgv Null(GV*)
#define DM_UID 0x003
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)
PTRSIZE == sizeof(void *)
DOUBLESIZE == sizeof(double)
LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE).
- Most of these are currently unused, but they are mentioned here so
- metaconfig will include the appropriate tests in Configure and
- we can then start to consider how best to deal with long long
- variables.
- Andy Dougherty April 1998
+
*/
+typedef I8TYPE I8;
+typedef U8TYPE U8;
+typedef I16TYPE I16;
+typedef U16TYPE U16;
+typedef I32TYPE I32;
+typedef U32TYPE U32;
+#ifdef PERL_CORE
+# ifdef HAS_QUAD
+# if QUADKIND == QUAD_IS_INT64_T
+# include <sys/types.h>
+# ifdef I_INTTYPES /* e.g. Linux has int64_t without <inttypes.h> */
+# include <inttypes.h>
+# endif
+# endif
+typedef I64TYPE I64;
+typedef U64TYPE U64;
+# endif
+#endif /* PERL_CORE */
+
+/* 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)
-typedef int8_t I8;
-typedef uint8_t U8;
/* 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
-typedef int16_t I16;
-typedef uint16_t U16;
#define I16_MAX INT16_MAX
#define I16_MIN INT16_MIN
#define U16_MAX UINT16_MAX
#define U16_MIN UINT16_MIN
-typedef int32_t I32;
-typedef uint32_t U32;
#define I32_MAX INT32_MAX
#define I32_MIN INT32_MIN
#define U32_MAX UINT32_MAX
#else
-typedef char I8;
-typedef unsigned char U8;
/* 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
-/* Beware. SHORTSIZE > 2 in Cray C90ties. */
-typedef short I16;
-typedef unsigned short U16;
#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
- typedef int I32;
- typedef unsigned int U32;
# 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
- typedef long I32;
- typedef unsigned long U32;
# define I32_MAX PERL_LONG_MAX
# define I32_MIN PERL_LONG_MIN
# define U32_MAX PERL_ULONG_MAX
esac
so="a"
-dlext="o"
+# AIX itself uses .o (libc.o) but we prefer compatibility
+# with the rest of the world and with rest of the scripting
+# languages (Tcl, Python) and related systems (SWIG).
+# Stephanie Beals <bealzy@us.ibm.com>
+dlext="so"
# Trying to set this breaks the POSIX.c compilation
'') archname="$osname" ;;
esac
+cc=${cc:-cc}
+
case "$osvers" in
3*) d_fchmod=undef
ccflags="$ccflags -D_ALL_SOURCE"
# symbol: boot_$(EXP) can it be auto-generated?
case "$osvers" in
3*)
- lddlflags="$lddlflags -H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc"
+ lddlflags="$lddlflags -H512 -T512 -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -e _nostart -lc"
;;
*)
- lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc"
+ lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -b noentry -lc"
;;
esac
esac
EOCBU
+# This script UU/uselfs.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use large files.
+cat > UU/uselfs.cbu <<'EOCBU'
+case "$uselargefiles" in
+$define|true|[yY]*)
+ lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`"
+ lfldflags="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`"
+ # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to
+ # insert(?) *something* to $ldflags so that later (in Configure) evaluating
+ # $ldflags causes a newline after the '-b64' (the result of the getconf).
+ # (nothing strange shows up in $ldflags even in hexdump;
+ # so it may be something in the shell, instead?)
+ # Try it out: just uncomment the below line and rerun Configure:
+# echo >&4 "AIX 4.3.1.0 $lfldflags mystery" ; exit 1
+ # Just don't ask me how AIX does it, I spent hours wondering.
+ # Therefore the line re-evaluating lfldflags: it seems to fix
+ # the whatever it was that AIX managed to break. --jhi
+ lfldflags="`echo $lfldflags`"
+ lflibs="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`"
+ case "$lfcflags$lfldflags$lflibs" in
+ '');;
+ *) ccflags="$ccflags $lfcflags"
+ ldflags="$ldflags $ldldflags"
+ libswanted="$libswanted $lflibs"
+ ;;
+ esac
+ lfcflags=''
+ lfldflags=''
+ lflibs=''
+ ;;
+esac
+EOCBU
+
# This script UU/use64bits.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use 64 bits.
cat > UU/use64bits.cbu <<'EOCBU'
exit 1
;;
esac
- ccflags="$ccflags -DUSE_LONG_LONG"
- ccflags="$ccflags `getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`"
-
- ldflags="$ldflags `getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`"
- # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to
- # insert(?) *something* to $ldflags so that later (in Configure) evaluating
- # $ldflags causes a newline after the '-b64' (the result of the getconf).
- # (nothing strange shows up in $ldflags even in hexdump;
- # so it may be something in the shell, instead?)
- # Try it out: just uncomment the below line and rerun Configure:
-# echo >&4 "AIX 4.3.1.0 $ldflags mystery" ; exit 1
- # Just don't ask me how AIX does it.
- # Therefore the line re-evaluating ldflags: it seems to bypass
- # the whatever it was that AIX managed to break. --jhi
- ldflags="`echo $ldflags`"
-
- libswanted="$libswanted `getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g'`"
+ case "$ccflags" in
+ *-DUSE_LONG_LONG*) ;;
+ *) ccflags="$ccflags -DUSE_LONG_LONG" ;;
+ esac
# When a 64-bit cc becomes available $archname64
# may need setting so that $archname gets it attached.
;;
# terminateAndUnload() which work correctly with C++ statics while libc
# load() and unload() do not. See ext/DynaLoader/dl_aix.xs.
# The C-to-C_r switch is done by usethreads.cbu, if needed.
-if test -f /lib/libC.a -a X"$gccversion" = X; then
+if test -f /lib/libC.a -a X"`$cc -v 2>&1 | grep gcc`" = X; then
# Cify libswanted.
set `echo X "$libswanted "| sed -e 's/ c / C c /'`
shift
# and it is called GEM. Many of the options we are going to use depend
# on the compiler style.
+cc=${cc:-cc}
+
# do NOT, I repeat, *NOT* take away the leading tabs
# Configure Black Magic (TM)
# reset
_DEC_cc_style=
-case "$cc" in
+case "`$cc -v 2>&1 | grep cc`" in
*gcc*) ;; # pass
*) # compile something small: taint.c is fine for this.
# the main point is the '-v' flag of 'cc'.
esac
# be nauseatingly ANSI
-case "$cc" in
+case "`$cc -v 2>&1 | grep gcc`" in
*gcc*) ccflags="$ccflags -ansi"
;;
*) ccflags="$ccflags -std"
# we want optimisation
case "$optimize" in
-'') case "$cc" in
+'') case "`$cc -v 2>&1 | grep gcc`" in
*gcc*)
optimize='-O3' ;;
*) case "$_DEC_cc_style" in
pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"'
+# The off_t is already 8 bytes, so we do have largefileness.
+
# This script UU/usethreads.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use threads.
cat > UU/usethreads.cbu <<'EOCBU'
case "$usethreads" in
$define|true|[yY]*)
- # Threads interfaces changed with V4.0.
- case "`uname -r`" in
- *[123].*)
- libswanted="$libswanted pthreads mach exc c_r"
- ccflags="-threads $ccflags"
- ;;
- *)
- libswanted="$libswanted pthread exc"
- ccflags="-pthread $ccflags"
+ # Threads interfaces changed with V4.0.
+ case "`$cc -v 2>&1 | grep gcc`" in
+ *gcc*)ccflags="-D_REENTRANT $ccflags" ;;
+ *) case "`uname -r`" in
+ *[123].*) ccflags="-threads $ccflags" ;;
+ *) ccflags="-pthread $ccflags" ;;
+ esac
;;
- esac
+ esac
+ case "`uname -r`" in
+ *[123].*) libswanted="$libswanted pthreads mach exc c_r" ;;
+ *) libswanted="$libswanted pthread exc" ;;
+ esac
usemymalloc='n'
;;
# * Set -Olimit to 3200 because perl_yylex.c got too big
# for the optimizer.
#
-
-
*gcc*) ccflags="$ccflags -DUINT32_MAX_BROKEN" ;;
esac
+cat > UU/cc.cbu <<'EOSH'
+# XXX This script UU/cc.cbu will get 'called-back' by Configure after it
+# XXX has prompted the user for the C compiler to use.
+# Get gcc to share its secrets.
+echo 'main() { return 0; }' > try.c
+ # Indent to avoid propagation to config.sh
+ verbose=`${cc:-cc} -v -o try try.c 2>&1`
+if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then
+ # Using gcc.
+ : nothing to see here, move on.
+else
+ # Using cc.
+ ar=${ar:-ar}
+ case "`$ar -V 2>&1`" in
+ *GNU*)
+ if test -x /usr/bin/ar; then
+ cat <<END >&2
+
+NOTE: You are using HP cc(1) but GNU ar(1). This might lead into trouble
+later on, I'm switching to HP ar to play safe.
+
+END
+ ar=/usr/bin/ar
+ fi
+ ;;
+ esac
+fi
+
+EOSH
+
# Date: Fri, 6 Sep 96 23:15:31 CDT
# From: "Daniel S. Lewart" <d-lewart@uiuc.edu>
# I looked through the gcc.info and found this:
esac
EOCBU
+# This script UU/uselfs.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use 64 bits.
+cat > UU/uselfs.cbu <<'EOCBU'
+case "$uselargefiles" in
+$define|true|[yY]*)
+ lfcflags="`getconf _CS_XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`"
+ lfldflags="`getconf _CS_XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`"
+ lflibs="`getconf _CS_XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`"
+ case "$lfcflags$lfldflags$lflibs" in
+ '');;
+ *) # This sucks. To get the HP-UX strict ANSI mode (-Aa) to
+ # approve of large file offsets, we must turn on the 64-bitness
+ # (+DD64), too. A callback file (a hack) calling another, yuck.
+ case "$use64bits" in
+ $undef|false|[nN]*|'')
+ use64bits="$define"
+ if $test -f use64bits.cbu; then
+ echo "(Large files in HP-UX require also 64-bitness, picking up 64-bit hints...)"
+ . ./use64bits.cbu
+ fi
+ ;;
+ esac
+ ccflags="$ccflags $lfcflags"
+ ldflags="$ldflags $ldldflags"
+ libswanted="$libswanted $lflibs"
+ ;;
+ esac
+ lfcflags=''
+ lfldflags=''
+ lflibs=''
+ ;;
+esac
+EOCBU
+
# This script UU/use64bits.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use 64 bits.
cat > UU/use64bits.cbu <<'EOCBU'
-case "$use64bits" in
+case "$ccflags" in
+*+DD64*) # Been here, done this (via uselfs.cbu, most likely.)
+ ;;
+*) case "$use64bits" in
$define|true|[yY]*)
if [ "$xxOsRevMajor" -lt 11 ]; then
cat <<EOM >&4
EOM
exit 1
fi
- ccflags="$ccflags +DD64 -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64"
+ ccflags="$ccflags +DD64"
ldflags="$ldflags +DD64"
ld=/usr/bin/ld
set `echo " $libswanted " | sed -e 's@ dl @ @'`
libswanted="$*"
glibpth="/lib/pa20_64"
+ esac
+ ;;
esac
EOCBU
+
+
+
esac
EOCBU
+# The -n32 makes off_t to be 8 bytes, so we should have largefileness.
+
# This script UU/use64bits.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use 64 bits.
cat > UU/use64bits.cbu <<'EOCBU'
exit 1
;;
esac
- case "$ccflags" in
+ case "$cc $ccflags" in
*-n32*)
- ccflags="$ccflags -DUSE_LONG_LONG"
+ case "$ccflags" in
+ *-DUSE_LONG_LONG) ;;
+ *) ccflags="$ccflags -DUSE_LONG_LONG" ;;
+ esac
archname64="-n32"
;;
esac
esac
EOCBU
+# This script UU/uselfs.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use large files.
+cat > UU/uselfs.cbu <<'EOCBU'
+case "$uselargefiles" in
+$define|true|[yY]*)
+ lfcflags="`getconf LFS_CFLAGS 2>/dev/null`"
+ lfldflags="`getconf LFS_LDFLAGS 2>/dev/null`"
+ lflibs="`getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`"
+ case "$lfcflags$lfldflags$lflibs" in
+ '');;
+ *) uselonglong="$define"
+ echo "(Large files in Solaris require also long longs, using long longs...)"
+ ccflags="$ccflags -DUSE_LONG_LONG $lfcflags"
+ ldflags="$ldflags $ldldflags"
+ libswanted="$libswanted $lflibs"
+ ;;
+ esac
+ lfcflags=''
+ lfldflags=''
+ lflibs=''
+ ;;
+esac
+EOCBU
+
# This script UU/use64bits.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use 64 bits.
cat > UU/use64bits.cbu <<'EOCBU'
exit 1
;;
esac
- ccflags="$ccflags `getconf LFS_CFLAGS`"
- ldflags="$ldflags `getconf LFS_LDFLAGS`"
- libswanted="$libswanted `getconf LFS_LIBS`"
- ccflags="$ccflags -DUSE_LONG_LONG"
+ case "$ccflags" in
+ *-DUSE_LONG_LONG*) ;;
+ *) ccflags="$ccflags -DUSE_LONG_LONG" ;;
+ esac
# When a 64-bit cc becomes available $archname64
# may need setting so that $archname gets it attached.
;;
# svr5 hints, System V Release 5.x (UnixWare 7)
-# Reworked by hops@sco.com Sept 1999 for better platform support
+# mods after mail fm Andy Dougherty
+# Reworked by hops@sco.com Sept/Oct 1999 for UW7.1 platform support
# Boyd Gerber, gerberb@zenez.com 1999/09/21 for threads support.
# Originally taken from svr4 hints.sh 21-Sep-98 hops@sco.com
# which was version of 1996/10/25 by Tye McQueen, tye@metronet.com
# Use Configure -Dusethreads to enable threads.
# Use Configure -Dcc=gcc to use gcc.
case "$cc" in
-'') cc='/bin/cc'
- test -f $cc || cc='/usr/ccs/bin/cc'
- ;;
*gcc*)
# "$gccversion" not set yet
vers=`gcc -v 2>&1 | sed -n -e 's@.*version \([^ ][^ ]*\) .*@\1@p'`
# Leave leading tabs so Configure doesn't propagate variables to config.sh
- want_ucb='' # don't use anything from /usr/ucblib - icky
- want_dbm='yes' # use dbm if can find library in /usr/local/lib
- want_gdbm='yes' # use gdbm if can find library in /usr/local/lib
- want_udk70='' # link with old static libc pieces
- # link with udk70 if want resulting binary to run on uw7.0*
- # - it will link in referenced static symbols of libc that are (now)
- # in the shared libc.so on 7.1 but were not in 7.0.
+ want_ucb='' # don't use anything from /usr/ucblib - icky
+ want_dbm='yes' # use dbm if can find library in /usr/local/lib
+ want_gdbm='yes' # use gdbm if can find library in /usr/local/lib
+ want_udk70='' # link with old static libc pieces
+ # link with udk70 if building on 7.1 abd want resulting binary
+ # to run on uw7.0* - it will link in referenced static symbols
+ # of libc that are (now) in the shared libc.so on 7.1 but were
+ # not there in 7.0.
# There are still scenarios where this is still insufficient so
# overall it is preferable to get ptf7051e
# ftp://ftp.sco.com/SLS/ptf7051e.Z
- # installed on any/all 7.0 systems.
+ # installed on any/all 7.0 systems and leave the above unset.
if [ "$want_ucb" ] ; then
ldflags= '-L/usr/ucblib'
fi
fi
-if [ "$want_gdbm" -a -f /usr/local/lib/libgdbm.so ] ; then
- i_gdbm='define'
-else
- i_gdbm='undef'
+if [ ! "$want_gdbm" ] ; then
+ i_gdbm='undef'
libswanted=`echo " $libswanted " | sed -e 's/ gdbm / /'`
fi
# libc: on UW7 don't want -lc explicitly as native cc gives warnings/errors
libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' -e 's/ c / /'`
-# Don't use irrelevant (but existing) lib dirs
-# don't want /usr/gnu/lib - original(older) system supplied distrib of perl5
-loclibpth=`echo " $loclibpth " | sed -e 's@ /usr/gnu/lib @ @'`
-
# remove /shlib and /lib from library search path as both symlink to /usr/lib
# where runtime shared libc is
glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /`
d_setregid='undef' d_setreuid='undef' # -- in /usr/lib/libc.so.1
-# use nm to probe libs - its fast enough on uw7
-case "$usenm" in
-'') usenm=true;;
-esac
-
# Broken C-Shell tests (Thanks to Tye McQueen):
# The OS-specific checks may be obsoleted by the this generic test.
sh_cnt=`sh -c 'echo /*' | wc -c`
# End of Unixware-specific tests.
###############################################################
-# Dynamic loading section:
+# Dynamic loading section: Is default so it should just happen.
+# set below to explicitly force.
+# usedl='define'
+# dlext='so'
+# dlsrc='dl_dlopen.xs'
#
# ccdlflags : must tell the linker to export all global symbols
# cccdlflags: must tell the compiler to generate relocatable code
# lddlflags : must tell the linker to output a shared library
-#
-# /usr/local/lib is added for convenience, since additional libraries
-# are usually put there
-#
+
# use shared perl lib
useshrplib='true'
case "$cc" in
*gcc*)
- ccdlflags='-Xlinker -Bexport -L/usr/local/lib'
+ ccdlflags='-Xlinker -Bexport '
cccdlflags='-fpic'
- lddlflags='-G -L/usr/local/lib'
+ lddlflags='-G '
;;
*)
- ccdlflags='-Wl,-Bexport -L/usr/local/lib'
+ ccdlflags='-Wl,-Bexport'
cccdlflags='-Kpic'
- lddlflags='-G -Wl,-Bexport -L/usr/local/lib'
+ lddlflags='-G -Wl,-Bexport'
;;
esac
-###############################################################
-# Use dynamic loading
-usedl='define'
-dlext='so'
-dlsrc='dl_dlopen.xs'
-
-
############################################################################
# Thread support
# use Configure -Dusethreads to enable
case "$usethreads" in
$define|true|[yY]*)
ccflags="$ccflags"
- set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
shift
libswanted="$*"
case "$cc" in
*gcc*)
ccflags="-D_REENTRANT $ccflags -fpic -pthread"
cccdlflags='-fpic'
- lddlflags='-pthread -G -L/usr/local/lib '
+ lddlflags='-pthread -G '
;;
*)
ccflags="-D_REENTRANT $ccflags -KPIC -Kthread"
- ccdlflags='-Kthread -Wl,-Bexport -L/usr/local/lib'
+ ccdlflags='-Kthread -Wl,-Bexport'
cccdlflags='-KPIC -Kthread'
- lddlflags='-G -Kthread -Wl,-Bexport -L/usr/local/lib'
- ldflags='-Kthread -L/usr/local/lib'
+ lddlflags='-G -Kthread -Wl,-Bexport '
+ ldflags='-Kthread'
;;
esac
esac
EOCBU
-# Just in case Configure fails to find lstat() Its in /usr/lib/libc.so.1.
-d_lstat=define
-
d_suidsafe='define' # "./Configure -d" can't figure this out easily
+
+################## final caveat msgs to builder ###############
+cat <<'EOM' >&4
+
+If you wish to use dynamic linking, you must use
+ LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH
+or
+ setenv LD_LIBRARY_PATH `pwd`
+before running make.
+
+If you are using shared libraries from /usr/local/lib
+for libdbm or libgdbm you may need to set
+ LD_RUN_PATH=/usr/local/lib; export LD_RUN_PATH
+in order for Configure to compile the simple test program
+
+EOM
#define PERL_IN_HV_C
#include "perl.h"
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
-#else
-# define MALLOC_OVERHEAD 16
-# define ARRAY_ALLOC_BYTES(size) ( ((size) < 64) \
- ? (size)*sizeof(HE*) \
- : (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
-#endif
-
STATIC HE*
S_new_he(pTHX)
{
unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
}
+#if defined(USE_ITHREADS)
+HE *
+Perl_he_dup(pTHX_ HE *e, bool shared)
+{
+ HE *ret;
+
+ if (!e)
+ return Nullhe;
+ /* look for it in the table first */
+ ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
+ ret = new_he();
+ ptr_table_store(PL_ptr_table, e, ret);
+
+ HeNEXT(ret) = he_dup(HeNEXT(e),shared);
+ if (HeKLEN(e) == HEf_SVKEY)
+ HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
+ else if (shared)
+ HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ else
+ HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
+ return ret;
+}
+#endif /* USE_ITHREADS */
+
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
* contains an SV* */
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
#else
#define MALLOC_OVERHEAD 16
- New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
if (a) {
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
#else
- New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
}
else {
- Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
+ Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
}
xhv->xhv_max = --newsize;
xhv->xhv_array = a;
#endif
if (!xhv->xhv_array)
- Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(506, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
if (entry)
entry = HeNEXT(entry);
while (!entry) {
#define HEK_HASH(hek) (hek)->hek_hash
#define HEK_LEN(hek) (hek)->hek_len
#define HEK_KEY(hek) (hek)->hek_key
+
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+# 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
use Cwd;
use Pod::Html;
-umask 022;
-
=head1 NAME
installhtml - converts a collection of POD pages to HTML format.
use vars qw($packlist);
require Cwd;
-umask 022;
$ENV{SHELL} = 'sh' if $^O eq 'os2';
$ver = $];
shift;
}
-umask 022 unless $Is_VMS;
-
my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc
utils/pl2pm utils/splain utils/perlcc utils/dprofpp
x2p/s2p x2p/find2perl
PERLVAR(Iorigargc, int)
PERLVAR(Iorigargv, char **)
PERLVAR(Ienvgv, GV *)
-PERLVAR(Isiggv, GV *)
PERLVAR(Iincgv, GV *)
PERLVAR(Ihintgv, GV *)
PERLVAR(Iorigfilename, char *)
PERLVAR(Idiehook, SV *)
PERLVAR(Iwarnhook, SV *)
-PERLVAR(Icddir, char *) /* switches */
+
+/* switches */
PERLVAR(Iminus_c, bool)
PERLVARA(Ipatchlevel,10,char)
PERLVAR(Ilocalpatches, char **)
PERLVAR(Idowarn, bool)
PERLVAR(Idoextract, bool)
PERLVAR(Isawampersand, bool) /* must save all match strings */
-PERLVAR(Isawstudy, bool) /* do fbm_instr on all strings */
-PERLVAR(Isawvec, bool)
PERLVAR(Iunsafe, bool)
PERLVAR(Iinplace, char *)
PERLVAR(Ie_script, SV *)
PERLVAR(Iperldb, U32)
-/* This value may be raised by extensions for testing purposes */
+/* This value may be set when embedding for full cleanup */
/* 0=none, 1=full, 2=full with checks */
PERLVARI(Iperl_destruct_level, int, 0)
/* 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
PERLVAR(Idefgv, GV *)
PERLVAR(Iargvgv, GV *)
PERLVAR(Iargvoutgv, GV *)
+PERLVAR(Iargvout_stack, AV *)
/* shortcuts to regexp stuff */
-/* XXX these three aren't used anywhere */
-PERLVAR(Ileftgv, GV *)
-PERLVAR(Iampergv, GV *)
-PERLVAR(Irightgv, GV *)
-
/* this one needs to be moved to thrdvar.h and accessed via
* find_threadsv() when USE_THREADS */
PERLVAR(Ireplgv, GV *)
PERLVAR(Icurstname, SV *) /* name of current package */
PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */
PERLVAR(Iendav, AV *) /* names of END subroutines */
+PERLVAR(Istopav, AV *) /* names of STOP subroutines */
PERLVAR(Iinitav, AV *) /* names of INIT subroutines */
PERLVAR(Istrtab, HV *) /* shared string table */
PERLVARI(Isub_generation,U32,1) /* incr to invalidate method cache */
PERLVAR(Isv_arenaroot, SV*) /* list of areas for garbage collection */
/* funky return mechanisms */
-PERLVAR(Ilastspbase, I32)
-PERLVAR(Ilastsize, I32)
PERLVAR(Iforkprocess, int) /* so do_open |- can return proc# */
/* subprocess state */
PERLVAR(Itainting, bool) /* doing taint checks */
PERLVARI(Iop_mask, char *, NULL) /* masked operations for safe evals */
-/* trace state */
-PERLVAR(Idlevel, I32)
-PERLVARI(Idlmax, I32, 128)
-PERLVAR(Idebname, char *)
-PERLVAR(Idebdelim, char *)
-
/* current interpreter roots */
PERLVAR(Imain_cv, CV *)
PERLVAR(Imain_root, OP *)
PERLVARI(Icopline, line_t, NOLINE)
/* statics moved here for shared library purposes */
-PERLVAR(Istrchop, SV) /* return value from chop */
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 */
-PERLVAR(Imystrk, SV *) /* temp key string for do_each() */
-PERLVAR(Ioldlastpm, PMOP *) /* for saving regexp context in debugger */
PERLVAR(Igensym, I32) /* next symbol for getsym() to define */
PERLVAR(Ipreambled, bool)
PERLVAR(Ipreambleav, AV *)
PERLVAR(Ilex_state, U32) /* next token is determined */
PERLVAR(Ilex_defer, U32) /* state after determined token */
-PERLVAR(Ilex_expect, expectation) /* expect 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_fakebrack, I32) /* outer bracket is mere delimiter */
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(Ioldbufptr, char *)
PERLVAR(Ioldoldbufptr, char *)
PERLVAR(Ibufend, char *)
-PERLVARI(Iexpect,expectation, XSTATE) /* how to interpret ambiguous tokens */
+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(Ipadix_floor, I32) /* how low may inner block reset padix */
PERLVAR(Ipad_reset_pending, I32) /* reset pad on next attempted alloc */
-PERLVAR(Ithisexpr, I32) /* name id for nothing_in_common() */
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
-PERLVAR(Icryptseen, I32) /* has fast crypt() been initialized? */
+PERLVAR(Icryptseen, bool) /* has fast crypt() been initialized? */
#endif
-PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */
+PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */
PERLVAR(Idebug, VOL U32) /* flags given to -D switch */
PERLVAR(Isrand_called, bool)
PERLVARA(Iuudmap,256, char)
PERLVAR(Ibitcount, char *)
-PERLVAR(Ifilter_debug, int)
#ifdef USE_THREADS
PERLVAR(Ithr_key, perl_key) /* For per-thread struct perl_thread* */
#endif /* USE_THREADS */
+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(ISock, struct IPerlSock*)
PERLVAR(IProc, struct IPerlProc*)
#endif
+
+#if defined(USE_ITHREADS)
+PERLVAR(Iptr_table, PTR_TBL_t*)
+#endif
extern void PerlIO_init (void);
#endif
+#ifndef Sighandler_t
+typedef Signal_t (*Sighandler_t) (int);
+#endif
+
#if defined(PERL_IMPLICIT_SYS)
#ifndef PerlIO
/* IPerlStdIO */
struct IPerlStdIO;
+struct IPerlStdIOInfo;
typedef PerlIO* (*LPStdin)(struct IPerlStdIO*);
typedef PerlIO* (*LPStdout)(struct IPerlStdIO*);
typedef PerlIO* (*LPStderr)(struct IPerlStdIO*);
const Fpos_t*);
typedef void (*LPInit)(struct IPerlStdIO*);
typedef void (*LPInitOSExtras)(struct IPerlStdIO*);
+typedef PerlIO* (*LPFdupopen)(struct IPerlStdIO*, PerlIO*);
struct IPerlStdIO
{
LPSetpos pSetpos;
LPInit pInit;
LPInitOSExtras pInitOSExtras;
+ LPFdupopen pFdupopen;
};
struct IPerlStdIOInfo
#undef init_os_extras
#define init_os_extras() \
(*PL_StdIO->pInitOSExtras)(PL_StdIO)
+#define PerlIO_fdupopen(f) \
+ (*PL_StdIO->pFdupopen)(PL_StdIO, (f))
#else /* PERL_IMPLICIT_SYS */
#include "perlsdio.h"
#include "perl.h"
+#define PerlIO_fdupopen(f) (f)
#endif /* PERL_IMPLICIT_SYS */
#ifndef PerlIO_setpos
extern int PerlIO_setpos (PerlIO *,const Fpos_t *);
#endif
+#ifndef PerlIO_fdupopen
+extern PerlIO * PerlIO_fdupopen (PerlIO *);
+#endif
/*
/* IPerlDir */
struct IPerlDir;
+struct IPerlDirInfo;
typedef int (*LPMakedir)(struct IPerlDir*, const char*, int);
typedef int (*LPChdir)(struct IPerlDir*, const char*);
typedef int (*LPRmdir)(struct IPerlDir*, const char*);
typedef void (*LPDirRewind)(struct IPerlDir*, DIR*);
typedef void (*LPDirSeek)(struct IPerlDir*, DIR*, long);
typedef long (*LPDirTell)(struct IPerlDir*, DIR*);
+#ifdef WIN32
+typedef char* (*LPDirMapPathA)(struct IPerlDir*, const char*);
+typedef WCHAR* (*LPDirMapPathW)(struct IPerlDir*, const WCHAR*);
+#endif
struct IPerlDir
{
LPDirRewind pRewind;
LPDirSeek pSeek;
LPDirTell pTell;
+#ifdef WIN32
+ LPDirMapPathA pMapPathA;
+ LPDirMapPathW pMapPathW;
+#endif
};
struct IPerlDirInfo
(*PL_Dir->pSeek)(PL_Dir, (dir), (loc))
#define PerlDir_tell(dir) \
(*PL_Dir->pTell)(PL_Dir, (dir))
+#ifdef WIN32
+#define PerlDir_mapA(dir) \
+ (*PL_Dir->pMapPathA)(PL_Dir, (dir))
+#define PerlDir_mapW(dir) \
+ (*PL_Dir->pMapPathW)(PL_Dir, (dir))
+#endif
#else /* PERL_IMPLICIT_SYS */
#define PerlDir_rewind(dir) rewinddir((dir))
#define PerlDir_seek(dir, loc) seekdir((dir), (loc))
#define PerlDir_tell(dir) telldir((dir))
+#ifdef WIN32
+#define PerlDir_mapA(dir) dir
+#define PerlDir_mapW(dir) dir
+#endif
#endif /* PERL_IMPLICIT_SYS */
/* IPerlEnv */
struct IPerlEnv;
+struct IPerlEnvInfo;
typedef char* (*LPEnvGetenv)(struct IPerlEnv*, const char*);
typedef int (*LPEnvPutenv)(struct IPerlEnv*, const char*);
typedef char* (*LPEnvGetenv_len)(struct IPerlEnv*,
#define PerlEnv_putenv(str) putenv((str))
#define PerlEnv_getenv(str) getenv((str))
#define PerlEnv_getenv_len(str,l) getenv_len((str), (l))
-#define PerlEnv_clear() clearenv()
+#define PerlEnv_clearenv() clearenv()
#define PerlEnv_get_childenv() get_childenv()
#define PerlEnv_free_childenv(e) free_childenv((e))
#define PerlEnv_get_childdir() get_childdir()
/* IPerlLIO */
struct IPerlLIO;
+struct IPerlLIOInfo;
typedef int (*LPLIOAccess)(struct IPerlLIO*, const char*, int);
typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int);
typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t,
typedef int (*LPLIOIOCtl)(struct IPerlLIO*, int, unsigned int,
char*);
typedef int (*LPLIOIsatty)(struct IPerlLIO*, int);
+typedef int (*LPLIOLink)(struct IPerlLIO*, const char*,
+ const char *);
typedef long (*LPLIOLseek)(struct IPerlLIO*, int, long, int);
typedef int (*LPLIOLstat)(struct IPerlLIO*, const char*,
struct stat*);
LPLIOFileStat pFileStat;
LPLIOIOCtl pIOCtl;
LPLIOIsatty pIsatty;
+ LPLIOLink pLink;
LPLIOLseek pLseek;
LPLIOLstat pLstat;
LPLIOMktemp pMktemp;
(*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf))
#define PerlLIO_isatty(fd) \
(*PL_LIO->pIsatty)(PL_LIO, (fd))
+#define PerlLIO_link(oldname, newname) \
+ (*PL_LIO->pLink)(PL_LIO, (oldname), (newname))
#define PerlLIO_lseek(fd, offset, mode) \
(*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode))
#define PerlLIO_lstat(name, buf) \
#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf))
#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf))
#define PerlLIO_isatty(fd) isatty((fd))
+#define PerlLIO_link(oldname, newname) link((oldname), (newname))
#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode))
#define PerlLIO_stat(name, buf) Stat((name), (buf))
#ifdef HAS_LSTAT
/* IPerlMem */
struct IPerlMem;
+struct IPerlMemInfo;
typedef void* (*LPMemMalloc)(struct IPerlMem*, size_t);
typedef void* (*LPMemRealloc)(struct IPerlMem*, void*, size_t);
typedef void (*LPMemFree)(struct IPerlMem*, void*);
+typedef void* (*LPMemCalloc)(struct IPerlMem*, size_t, size_t);
+typedef void (*LPMemGetLock)(struct IPerlMem*);
+typedef void (*LPMemFreeLock)(struct IPerlMem*);
+typedef int (*LPMemIsLocked)(struct IPerlMem*);
struct IPerlMem
{
LPMemMalloc pMalloc;
LPMemRealloc pRealloc;
LPMemFree pFree;
+ LPMemCalloc pCalloc;
+ LPMemGetLock pGetLock;
+ LPMemFreeLock pFreeLock;
+ LPMemIsLocked pIsLocked;
};
struct IPerlMemInfo
struct IPerlMem perlMemList;
};
+/* Interpreter specific memory macros */
#define PerlMem_malloc(size) \
(*PL_Mem->pMalloc)(PL_Mem, (size))
#define PerlMem_realloc(buf, size) \
(*PL_Mem->pRealloc)(PL_Mem, (buf), (size))
#define PerlMem_free(buf) \
(*PL_Mem->pFree)(PL_Mem, (buf))
+#define PerlMem_calloc(num, size) \
+ (*PL_Mem->pCalloc)(PL_Mem, (num), (size))
+#define PerlMem_get_lock() \
+ (*PL_Mem->pGetLock)(PL_Mem)
+#define PerlMem_free_lock() \
+ (*PL_Mem->pFreeLock)(PL_Mem)
+#define PerlMem_is_locked() \
+ (*PL_Mem->pIsLocked)(PL_Mem)
+
+/* Shared memory macros */
+#define PerlMemShared_malloc(size) \
+ (*PL_MemShared->pMalloc)(PL_Mem, (size))
+#define PerlMemShared_realloc(buf, size) \
+ (*PL_MemShared->pRealloc)(PL_Mem, (buf), (size))
+#define PerlMemShared_free(buf) \
+ (*PL_MemShared->pFree)(PL_Mem, (buf))
+#define PerlMemShared_calloc(num, size) \
+ (*PL_MemShared->pCalloc)(PL_Mem, (num), (size))
+#define PerlMemShared_get_lock() \
+ (*PL_MemShared->pGetLock)(PL_Mem)
+#define PerlMemShared_free_lock() \
+ (*PL_MemShared->pFreeLock)(PL_Mem)
+#define PerlMemShared_is_locked() \
+ (*PL_MemShared->pIsLocked)(PL_Mem)
+
+
+/* Parse tree memory macros */
+#define PerlMemParse_malloc(size) \
+ (*PL_MemParse->pMalloc)(PL_Mem, (size))
+#define PerlMemParse_realloc(buf, size) \
+ (*PL_MemParse->pRealloc)(PL_Mem, (buf), (size))
+#define PerlMemParse_free(buf) \
+ (*PL_MemParse->pFree)(PL_Mem, (buf))
+#define PerlMemParse_calloc(num, size) \
+ (*PL_MemParse->pCalloc)(PL_Mem, (num), (size))
+#define PerlMemParse_get_lock() \
+ (*PL_MemParse->pGetLock)(PL_Mem)
+#define PerlMemParse_free_lock() \
+ (*PL_MemParse->pFreeLock)(PL_Mem)
+#define PerlMemParse_is_locked() \
+ (*PL_MemParse->pIsLocked)(PL_Mem)
+
#else /* PERL_IMPLICIT_SYS */
+/* Interpreter specific memory macros */
#define PerlMem_malloc(size) malloc((size))
#define PerlMem_realloc(buf, size) realloc((buf), (size))
#define PerlMem_free(buf) free((buf))
+#define PerlMem_calloc(num, size) calloc((num), (size))
+#define PerlMem_get_lock()
+#define PerlMem_free_lock()
+#define PerlMem_is_locked() 0
+
+/* Shared memory macros */
+#define PerlMemShared_malloc(size) malloc((size))
+#define PerlMemShared_realloc(buf, size) realloc((buf), (size))
+#define PerlMemShared_free(buf) free((buf))
+#define PerlMemShared_calloc(num, size) calloc((num), (size))
+#define PerlMemShared_get_lock()
+#define PerlMemShared_free_lock()
+#define PerlMemShared_is_locked() 0
+
+/* Parse tree memory macros */
+#define PerlMemParse_malloc(size) malloc((size))
+#define PerlMemParse_realloc(buf, size) realloc((buf), (size))
+#define PerlMemParse_free(buf) free((buf))
+#define PerlMemParse_calloc(num, size) calloc((num), (size))
+#define PerlMemParse_get_lock()
+#define PerlMemParse_free_lock()
+#define PerlMemParse_is_locked() 0
#endif /* PERL_IMPLICIT_SYS */
#if defined(PERL_IMPLICIT_SYS)
-#ifndef Sighandler_t
-typedef Signal_t (*Sighandler_t) (int);
-#endif
#ifndef jmp_buf
#include <setjmp.h>
#endif
/* IPerlProc */
struct IPerlProc;
+struct IPerlProcInfo;
typedef void (*LPProcAbort)(struct IPerlProc*);
typedef char* (*LPProcCrypt)(struct IPerlProc*, const char*,
const char*);
typedef int (*LPProcWait)(struct IPerlProc*, int*);
typedef int (*LPProcWaitpid)(struct IPerlProc*, int, int*, int);
typedef Sighandler_t (*LPProcSignal)(struct IPerlProc*, int, Sighandler_t);
-typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*);
+typedef int (*LPProcFork)(struct IPerlProc*);
+typedef int (*LPProcGetpid)(struct IPerlProc*);
#ifdef WIN32
+typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*);
typedef void (*LPProcGetOSError)(struct IPerlProc*,
SV* sv, DWORD dwErr);
typedef void (*LPProcFreeBuf)(struct IPerlProc*, char*);
LPProcWait pWait;
LPProcWaitpid pWaitpid;
LPProcSignal pSignal;
+ LPProcFork pFork;
+ LPProcGetpid pGetpid;
#ifdef WIN32
LPProcDynaLoader pDynaLoader;
LPProcGetOSError pGetOSError;
(*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f))
#define PerlProc_signal(n, h) \
(*PL_Proc->pSignal)(PL_Proc, (n), (h))
+#define PerlProc_fork() \
+ (*PL_Proc->pFork)(PL_Proc)
+#define PerlProc_getpid() \
+ (*PL_Proc->pGetpid)(PL_Proc)
#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#define PerlProc_signal(n, h) signal((n), (h))
+#define PerlProc_fork() fork()
+#define PerlProc_getpid() getpid()
#ifdef WIN32
#define PerlProc_DynaLoad(f) \
/* PerlSock */
struct IPerlSock;
+struct IPerlSockInfo;
typedef u_long (*LPHtonl)(struct IPerlSock*, u_long);
typedef u_short (*LPHtons)(struct IPerlSock*, u_short);
typedef u_long (*LPNtohl)(struct IPerlSock*, u_long);
#endif /* PERL_IMPLICIT_SYS */
-/* Mention
-
- HAS_READV
- HAS_RECVMSG
- HAS_SENDMSG
- HAS_WRITEV
- HAS_STRUCT_MSGHDR
- HAS_STRUCT_CMSGHDR
-
- here so that Configure picks them up. Perl core does not
- use them but somebody might want to extend Socket:: or IO::
- someday.
-
- Jarkko Hietaniemi November 1998
-
- */
-
#endif /* __Inc__IPerl___ */
#define KEY_LE 15
#define KEY_LT 16
#define KEY_NE 17
-#define KEY_abs 18
-#define KEY_accept 19
-#define KEY_alarm 20
-#define KEY_and 21
-#define KEY_atan2 22
-#define KEY_bind 23
-#define KEY_binmode 24
-#define KEY_bless 25
-#define KEY_caller 26
-#define KEY_chdir 27
-#define KEY_chmod 28
-#define KEY_chomp 29
-#define KEY_chop 30
-#define KEY_chown 31
-#define KEY_chr 32
-#define KEY_chroot 33
-#define KEY_close 34
-#define KEY_closedir 35
-#define KEY_cmp 36
-#define KEY_connect 37
-#define KEY_continue 38
-#define KEY_cos 39
-#define KEY_crypt 40
-#define KEY_dbmclose 41
-#define KEY_dbmopen 42
-#define KEY_defined 43
-#define KEY_delete 44
-#define KEY_die 45
-#define KEY_do 46
-#define KEY_dump 47
-#define KEY_each 48
-#define KEY_else 49
-#define KEY_elsif 50
-#define KEY_endgrent 51
-#define KEY_endhostent 52
-#define KEY_endnetent 53
-#define KEY_endprotoent 54
-#define KEY_endpwent 55
-#define KEY_endservent 56
-#define KEY_eof 57
-#define KEY_eq 58
-#define KEY_eval 59
-#define KEY_exec 60
-#define KEY_exists 61
-#define KEY_exit 62
-#define KEY_exp 63
-#define KEY_fcntl 64
-#define KEY_fileno 65
-#define KEY_flock 66
-#define KEY_for 67
-#define KEY_foreach 68
-#define KEY_fork 69
-#define KEY_format 70
-#define KEY_formline 71
-#define KEY_ge 72
-#define KEY_getc 73
-#define KEY_getgrent 74
-#define KEY_getgrgid 75
-#define KEY_getgrnam 76
-#define KEY_gethostbyaddr 77
-#define KEY_gethostbyname 78
-#define KEY_gethostent 79
-#define KEY_getlogin 80
-#define KEY_getnetbyaddr 81
-#define KEY_getnetbyname 82
-#define KEY_getnetent 83
-#define KEY_getpeername 84
-#define KEY_getpgrp 85
-#define KEY_getppid 86
-#define KEY_getpriority 87
-#define KEY_getprotobyname 88
-#define KEY_getprotobynumber 89
-#define KEY_getprotoent 90
-#define KEY_getpwent 91
-#define KEY_getpwnam 92
-#define KEY_getpwuid 93
-#define KEY_getservbyname 94
-#define KEY_getservbyport 95
-#define KEY_getservent 96
-#define KEY_getsockname 97
-#define KEY_getsockopt 98
-#define KEY_glob 99
-#define KEY_gmtime 100
-#define KEY_goto 101
-#define KEY_grep 102
-#define KEY_gt 103
-#define KEY_hex 104
-#define KEY_if 105
-#define KEY_index 106
-#define KEY_int 107
-#define KEY_ioctl 108
-#define KEY_join 109
-#define KEY_keys 110
-#define KEY_kill 111
-#define KEY_last 112
-#define KEY_lc 113
-#define KEY_lcfirst 114
-#define KEY_le 115
-#define KEY_length 116
-#define KEY_link 117
-#define KEY_listen 118
-#define KEY_local 119
-#define KEY_localtime 120
-#define KEY_lock 121
-#define KEY_log 122
-#define KEY_lstat 123
-#define KEY_lt 124
-#define KEY_m 125
-#define KEY_map 126
-#define KEY_mkdir 127
-#define KEY_msgctl 128
-#define KEY_msgget 129
-#define KEY_msgrcv 130
-#define KEY_msgsnd 131
-#define KEY_my 132
-#define KEY_ne 133
-#define KEY_next 134
-#define KEY_no 135
-#define KEY_not 136
-#define KEY_oct 137
-#define KEY_open 138
-#define KEY_opendir 139
-#define KEY_or 140
-#define KEY_ord 141
-#define KEY_our 142
-#define KEY_pack 143
-#define KEY_package 144
-#define KEY_pipe 145
-#define KEY_pop 146
-#define KEY_pos 147
-#define KEY_print 148
-#define KEY_printf 149
-#define KEY_prototype 150
-#define KEY_push 151
-#define KEY_q 152
-#define KEY_qq 153
-#define KEY_qr 154
-#define KEY_quotemeta 155
-#define KEY_qw 156
-#define KEY_qx 157
-#define KEY_rand 158
-#define KEY_read 159
-#define KEY_readdir 160
-#define KEY_readline 161
-#define KEY_readlink 162
-#define KEY_readpipe 163
-#define KEY_recv 164
-#define KEY_redo 165
-#define KEY_ref 166
-#define KEY_rename 167
-#define KEY_require 168
-#define KEY_reset 169
-#define KEY_return 170
-#define KEY_reverse 171
-#define KEY_rewinddir 172
-#define KEY_rindex 173
-#define KEY_rmdir 174
-#define KEY_s 175
-#define KEY_scalar 176
-#define KEY_seek 177
-#define KEY_seekdir 178
-#define KEY_select 179
-#define KEY_semctl 180
-#define KEY_semget 181
-#define KEY_semop 182
-#define KEY_send 183
-#define KEY_setgrent 184
-#define KEY_sethostent 185
-#define KEY_setnetent 186
-#define KEY_setpgrp 187
-#define KEY_setpriority 188
-#define KEY_setprotoent 189
-#define KEY_setpwent 190
-#define KEY_setservent 191
-#define KEY_setsockopt 192
-#define KEY_shift 193
-#define KEY_shmctl 194
-#define KEY_shmget 195
-#define KEY_shmread 196
-#define KEY_shmwrite 197
-#define KEY_shutdown 198
-#define KEY_sin 199
-#define KEY_sleep 200
-#define KEY_socket 201
-#define KEY_socketpair 202
-#define KEY_sort 203
-#define KEY_splice 204
-#define KEY_split 205
-#define KEY_sprintf 206
-#define KEY_sqrt 207
-#define KEY_srand 208
-#define KEY_stat 209
-#define KEY_study 210
-#define KEY_sub 211
-#define KEY_substr 212
-#define KEY_symlink 213
-#define KEY_syscall 214
-#define KEY_sysopen 215
-#define KEY_sysread 216
-#define KEY_sysseek 217
-#define KEY_system 218
-#define KEY_syswrite 219
-#define KEY_tell 220
-#define KEY_telldir 221
-#define KEY_tie 222
-#define KEY_tied 223
-#define KEY_time 224
-#define KEY_times 225
-#define KEY_tr 226
-#define KEY_truncate 227
-#define KEY_uc 228
-#define KEY_ucfirst 229
-#define KEY_umask 230
-#define KEY_undef 231
-#define KEY_unless 232
-#define KEY_unlink 233
-#define KEY_unpack 234
-#define KEY_unshift 235
-#define KEY_untie 236
-#define KEY_until 237
-#define KEY_use 238
-#define KEY_utime 239
-#define KEY_values 240
-#define KEY_vec 241
-#define KEY_wait 242
-#define KEY_waitpid 243
-#define KEY_wantarray 244
-#define KEY_warn 245
-#define KEY_while 246
-#define KEY_write 247
-#define KEY_x 248
-#define KEY_xor 249
-#define KEY_y 250
+#define KEY_STOP 18
+#define KEY_abs 19
+#define KEY_accept 20
+#define KEY_alarm 21
+#define KEY_and 22
+#define KEY_atan2 23
+#define KEY_bind 24
+#define KEY_binmode 25
+#define KEY_bless 26
+#define KEY_caller 27
+#define KEY_chdir 28
+#define KEY_chmod 29
+#define KEY_chomp 30
+#define KEY_chop 31
+#define KEY_chown 32
+#define KEY_chr 33
+#define KEY_chroot 34
+#define KEY_close 35
+#define KEY_closedir 36
+#define KEY_cmp 37
+#define KEY_connect 38
+#define KEY_continue 39
+#define KEY_cos 40
+#define KEY_crypt 41
+#define KEY_dbmclose 42
+#define KEY_dbmopen 43
+#define KEY_defined 44
+#define KEY_delete 45
+#define KEY_die 46
+#define KEY_do 47
+#define KEY_dump 48
+#define KEY_each 49
+#define KEY_else 50
+#define KEY_elsif 51
+#define KEY_endgrent 52
+#define KEY_endhostent 53
+#define KEY_endnetent 54
+#define KEY_endprotoent 55
+#define KEY_endpwent 56
+#define KEY_endservent 57
+#define KEY_eof 58
+#define KEY_eq 59
+#define KEY_eval 60
+#define KEY_exec 61
+#define KEY_exists 62
+#define KEY_exit 63
+#define KEY_exp 64
+#define KEY_fcntl 65
+#define KEY_fileno 66
+#define KEY_flock 67
+#define KEY_for 68
+#define KEY_foreach 69
+#define KEY_fork 70
+#define KEY_format 71
+#define KEY_formline 72
+#define KEY_ge 73
+#define KEY_getc 74
+#define KEY_getgrent 75
+#define KEY_getgrgid 76
+#define KEY_getgrnam 77
+#define KEY_gethostbyaddr 78
+#define KEY_gethostbyname 79
+#define KEY_gethostent 80
+#define KEY_getlogin 81
+#define KEY_getnetbyaddr 82
+#define KEY_getnetbyname 83
+#define KEY_getnetent 84
+#define KEY_getpeername 85
+#define KEY_getpgrp 86
+#define KEY_getppid 87
+#define KEY_getpriority 88
+#define KEY_getprotobyname 89
+#define KEY_getprotobynumber 90
+#define KEY_getprotoent 91
+#define KEY_getpwent 92
+#define KEY_getpwnam 93
+#define KEY_getpwuid 94
+#define KEY_getservbyname 95
+#define KEY_getservbyport 96
+#define KEY_getservent 97
+#define KEY_getsockname 98
+#define KEY_getsockopt 99
+#define KEY_glob 100
+#define KEY_gmtime 101
+#define KEY_goto 102
+#define KEY_grep 103
+#define KEY_gt 104
+#define KEY_hex 105
+#define KEY_if 106
+#define KEY_index 107
+#define KEY_int 108
+#define KEY_ioctl 109
+#define KEY_join 110
+#define KEY_keys 111
+#define KEY_kill 112
+#define KEY_last 113
+#define KEY_lc 114
+#define KEY_lcfirst 115
+#define KEY_le 116
+#define KEY_length 117
+#define KEY_link 118
+#define KEY_listen 119
+#define KEY_local 120
+#define KEY_localtime 121
+#define KEY_lock 122
+#define KEY_log 123
+#define KEY_lstat 124
+#define KEY_lt 125
+#define KEY_m 126
+#define KEY_map 127
+#define KEY_mkdir 128
+#define KEY_msgctl 129
+#define KEY_msgget 130
+#define KEY_msgrcv 131
+#define KEY_msgsnd 132
+#define KEY_my 133
+#define KEY_ne 134
+#define KEY_next 135
+#define KEY_no 136
+#define KEY_not 137
+#define KEY_oct 138
+#define KEY_open 139
+#define KEY_opendir 140
+#define KEY_or 141
+#define KEY_ord 142
+#define KEY_our 143
+#define KEY_pack 144
+#define KEY_package 145
+#define KEY_pipe 146
+#define KEY_pop 147
+#define KEY_pos 148
+#define KEY_print 149
+#define KEY_printf 150
+#define KEY_prototype 151
+#define KEY_push 152
+#define KEY_q 153
+#define KEY_qq 154
+#define KEY_qr 155
+#define KEY_quotemeta 156
+#define KEY_qw 157
+#define KEY_qx 158
+#define KEY_rand 159
+#define KEY_read 160
+#define KEY_readdir 161
+#define KEY_readline 162
+#define KEY_readlink 163
+#define KEY_readpipe 164
+#define KEY_recv 165
+#define KEY_redo 166
+#define KEY_ref 167
+#define KEY_rename 168
+#define KEY_require 169
+#define KEY_reset 170
+#define KEY_return 171
+#define KEY_reverse 172
+#define KEY_rewinddir 173
+#define KEY_rindex 174
+#define KEY_rmdir 175
+#define KEY_s 176
+#define KEY_scalar 177
+#define KEY_seek 178
+#define KEY_seekdir 179
+#define KEY_select 180
+#define KEY_semctl 181
+#define KEY_semget 182
+#define KEY_semop 183
+#define KEY_send 184
+#define KEY_setgrent 185
+#define KEY_sethostent 186
+#define KEY_setnetent 187
+#define KEY_setpgrp 188
+#define KEY_setpriority 189
+#define KEY_setprotoent 190
+#define KEY_setpwent 191
+#define KEY_setservent 192
+#define KEY_setsockopt 193
+#define KEY_shift 194
+#define KEY_shmctl 195
+#define KEY_shmget 196
+#define KEY_shmread 197
+#define KEY_shmwrite 198
+#define KEY_shutdown 199
+#define KEY_sin 200
+#define KEY_sleep 201
+#define KEY_socket 202
+#define KEY_socketpair 203
+#define KEY_sort 204
+#define KEY_splice 205
+#define KEY_split 206
+#define KEY_sprintf 207
+#define KEY_sqrt 208
+#define KEY_srand 209
+#define KEY_stat 210
+#define KEY_study 211
+#define KEY_sub 212
+#define KEY_substr 213
+#define KEY_symlink 214
+#define KEY_syscall 215
+#define KEY_sysopen 216
+#define KEY_sysread 217
+#define KEY_sysseek 218
+#define KEY_system 219
+#define KEY_syswrite 220
+#define KEY_tell 221
+#define KEY_telldir 222
+#define KEY_tie 223
+#define KEY_tied 224
+#define KEY_time 225
+#define KEY_times 226
+#define KEY_tr 227
+#define KEY_truncate 228
+#define KEY_uc 229
+#define KEY_ucfirst 230
+#define KEY_umask 231
+#define KEY_undef 232
+#define KEY_unless 233
+#define KEY_unlink 234
+#define KEY_unpack 235
+#define KEY_unshift 236
+#define KEY_untie 237
+#define KEY_until 238
+#define KEY_use 239
+#define KEY_utime 240
+#define KEY_values 241
+#define KEY_vec 242
+#define KEY_wait 243
+#define KEY_waitpid 244
+#define KEY_wantarray 245
+#define KEY_warn 246
+#define KEY_while 247
+#define KEY_write 248
+#define KEY_x 249
+#define KEY_xor 250
+#define KEY_y 251
LE
LT
NE
+STOP
abs
accept
alarm
@EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD);
$is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
$is_vms = $^O eq 'VMS';
- $VERSION = $VERSION = '5.57';
+ $VERSION = '5.57';
}
AUTOLOAD {
=head1 NAME
-Benchmark - benchmark running times of code
-
-timethis - run a chunk of code several times
-
-timethese - run several chunks of code several times
-
-cmpthese - print results of timethese as a comparison chart
-
-timeit - run a chunk of code and see how long it goes
-
-countit - see how many times a chunk of code runs in a given time
+Benchmark - benchmark running times of Perl code
=head1 SYNOPSIS
The Benchmark module encapsulates a number of routines to help you
figure out how long it takes to execute some code.
+timethis - run a chunk of code several times
+
+timethese - run several chunks of code several times
+
+cmpthese - print results of timethese as a comparison chart
+
+timeit - run a chunk of code and see how long it goes
+
+countit - see how many times a chunk of code runs in a given time
+
+
=head2 Methods
=over 10
more than the system time of the loop with the actual
code and therefore the difference might end up being E<lt> 0.
+=head1 SEE ALSO
+
+L<Devel::DProf> - a Perl code profiler
+
=head1 AUTHORS
Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
@EXPORT_OK=qw(timesum cmpthese countit
clearcache clearallcache disablecache enablecache);
+$VERSION = 1.00;
+
&init;
sub init {
=head1 AUTHOR
-Gurusamy Sarathy gsar@umich.edu
+Gurusamy Sarathy gsar@activestate.com
This code heavily adapted from an early version of perl5db.pl attributable
to Larry Wall and the Perl Porters.
my $version = ${"${pkg}::VERSION"};
if (!$version or $version < $wanted) {
$version ||= "(undef)";
- my $file = $INC{"$pkg.pm"};
+ # %INC contains slashes, but $pkg contains double-colons.
+ my $file = (map {s,::,/,g; $INC{$_}} "$pkg.pm")[0];
$file &&= " ($file)";
require Carp;
Carp::croak("$pkg $wanted required--this is only version $version$file")
}
$packlist->read($pack{"read"}) if (-f $pack{"read"});
my $cwd = cwd();
- my $umask = umask 0 unless $Is_VMS;
my($source);
MOD_INSTALL: foreach $source (sort keys %hash) {
print "Writing $pack{'write'}\n";
$packlist->write($pack{'write'});
}
- umask $umask unless $Is_VMS;
}
sub directory_not_empty ($) {
close(FROMTO);
}
- my $umask = umask 0022 unless $Is_VMS;
mkpath($autodir,0,0755);
foreach (keys %$fromto) {
next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
next unless /\.pm$/;
autosplit($fromto->{$_},$autodir);
}
- umask $umask unless $Is_VMS;
}
package ExtUtils::Install::Warn;
my($self, $subdir) = @_;
my(@m);
if ($Is_Win32 && Win32::IsWin95()) {
+ # XXX: dmake-specific, like rest of Win95 port
return <<EOT;
subdirs ::
+@[
cd $subdir
\$(MAKE) all \$(PASTHRU)
cd ..
+]
EOT
}
else {
XSUBPPDIR = $xsdir
XSUBPP = \$(XSUBPPDIR)/$xsubpp
XSPROTOARG = $self->{XSPROTOARG}
-XSUBPPDEPS = @tmdeps
+XSUBPPDEPS = @tmdeps \$(XSUBPP)
XSUBPPARGS = @tmargs
};
};
$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
# a few workarounds for command.com (very basic)
-if (Win32::IsWin95()) {
+{
package ExtUtils::MM_Win95;
- unshift @MM::ISA, 'ExtUtils::MM_Win95';
+
+ # the $^O test may be overkill, but we want to be sure Win32::IsWin95()
+ # exists before we try it
+
+ unshift @MM::ISA, 'ExtUtils::MM_Win95'
+ if ($^O =~ /Win32/ && Win32::IsWin95());
sub xs_c {
my($self) = shift;
sub xs_o {
my($self) = shift;
return '' unless $self->needs_linking();
- # Dmake gets confused with 2 ways of making things
- return '' if $ExtUtils::MM_Win32::DMAKE;
'
.xs$(OBJ_EXT):
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\
$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
';
}
-}
+} # end of command.com workarounds
sub dlsyms {
my($self,%attribs) = @_;
my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
my($ldfrom) = '$(LDFROM)';
my(@m);
+
+# several things for GCC/Mingw32:
+# 1. use correct CRT startup objects (possibly unnecessary)
+# 2. try to overcome non-relocateable-DLL problems by generating
+# a (hopefully unique) image-base from the dll's name
+# -- BKS, 10-19-1999
+ if ($GCC) {
+ $otherldflags .= ' -L$(PERL_ARCHIVE:d) -nostdlib $(PERL_ARCHIVE:d)gdllcrt0.o ';
+ my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
+ $dllname =~ /(....)(.{0,4})/;
+ my $baseaddr = unpack("n", $1 ^ $2);
+ $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
+ }
+
push(@m,'
# This section creates the dynamically loadable $(INST_DYNAMIC)
# from $(OBJECT) and possibly $(MYEXTLIB).
require File::Basename;
my(%dirs,$file);
$target = VMS::Filespec::unixify($target) if $Is_VMS;
- umask 0 unless $Is_VMS;
File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
foreach $file (keys %$read){
$file = VMS::Filespec::unixify($file) if $Is_VMS;
=head1 AUTHOR
-Gurusamy Sarathy <gsar@umich.edu>
+Gurusamy Sarathy <gsar@activestate.com>
=head1 HISTORY
=head1 SYNOPSIS
use File::Find;
- find(\&wanted, '/foo','/bar');
+ find(\&wanted, '/foo', '/bar');
sub wanted { ... }
use File::Find;
- finddepth(\&wanted, '/foo','/bar');
+ finddepth(\&wanted, '/foo', '/bar');
sub wanted { ... }
+
+ use File::Find;
+ find({ wanted => \&process, follow => 1 }, '.');
=head1 DESCRIPTION
The first argument to find() is either a hash reference describing the
-operations to be performed for each file, a code reference, or a string
-that contains a subroutine name. If it is a hash reference, then the
-value for the key C<wanted> should be a code reference. This code
-reference is called I<the wanted() function> below.
+operations to be performed for each file, or a code reference.
-Currently the only other supported key for the above hash is
-C<bydepth>, in presense of which the walk over directories is
-performed depth-first. Entry point finddepth() is a shortcut for
-specifying C<{ bydepth => 1}> in the first argument of find().
+Here are the possible keys for the hash:
+
+=over 3
+
+=item C<wanted>
+
+The value should be a code reference. This code reference is called
+I<the wanted() function> below.
+
+=item C<bydepth>
+
+Reports the name of a directory only AFTER all its entries
+have been reported. Entry point finddepth() is a shortcut for
+specifying C<{ bydepth => 1 }> in the first argument of find().
+
+=item C<follow>
+
+Causes symbolic links to be followed. Since directory trees with symbolic
+links (followed) may contain files more than once and may even have
+cycles, a hash has to be built up with an entry for each file.
+This might be expensive both in space and time for a large
+directory tree. See I<follow_fast> and I<follow_skip> below.
+If either I<follow> or I<follow_fast> is in effect:
+
+=over 6
+
+=item
+
+It is guarantueed that an I<lstat> has been called before the user's
+I<wanted()> function is called. This enables fast file checks involving S< _>.
+
+=item
+
+There is a variable C<$File::Find::fullname> which holds the absolute
+pathname of the file with all symbolic links resolved
+
+=back
+
+=item C<follow_fast>
+
+This is similar to I<follow> except that it may report some files
+more than once. It does detect cycles however.
+Since only symbolic links have to be hashed, this is
+much cheaper both in space and time.
+If processing a file more than once (by the user's I<wanted()> function)
+is worse than just taking time, the option I<follow> should be used.
+
+=item C<follow_skip>
+
+C<follow_skip==1>, which is the default, causes all files which are
+neither directories nor symbolic links to be ignored if they are about
+to be processed a second time. If a directory or a symbolic link
+are about to be processed a second time, File::Find dies.
+C<follow_skip==0> causes File::Find to die if any file is about to be
+processed a second time.
+C<follow_skip==2> causes File::Find to ignore any duplicate files and
+dirctories but to proceed normally otherwise.
-The wanted() function does whatever verifications you want.
-$File::Find::dir contains the current directory name, and $_ the
-current filename within that directory. $File::Find::name contains
-C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when
-the function is called. The function may set $File::Find::prune to
-prune the tree.
-File::Find assumes that you don't alter the $_ variable. If you do then
-make sure you return it to its original value before exiting your function.
+=item C<no_chdir>
+
+Does not C<chdir()> to each directory as it recurses. The wanted()
+function will need to be aware of this, of course. In this case,
+C<$_> will be the same as C<$File::Find::name>.
+
+=item C<untaint>
+
+If find is used in taint-mode (-T command line switch or if EUID != UID
+or if EGID != GID) then internally directory names have to be untainted
+before they can be cd'ed to. Therefore they are checked against a regular
+expression I<untaint_pattern>. Note, that all names passed to the
+user's I<wanted()> function are still tainted.
+
+=item C<untaint_pattern>
+
+See above. This should be set using the C<qr> quoting operator.
+The default is set to C<qr|^([-+@\w./]+)$|>.
+Note that the paranthesis which are vital.
+
+=item C<untaint_skip>
+
+If set, directories (subtrees) which fail the I<untaint_pattern>
+are skipped. The default is to 'die' in such a case.
+
+=back
+
+The wanted() function does whatever verifications you want.
+C<$File::Find::dir> contains the current directory name, and C<$_> the
+current filename within that directory. C<$File::Find::name> contains
+the complete pathname to the file. You are chdir()'d to C<$File::Find::dir> when
+the function is called, unless C<no_chdir> was specified.
+When <follow> or <follow_fast> are in effect there is also a
+C<$File::Find::fullname>.
+The function may set C<$File::Find::prune> to prune the tree
+unless C<bydepth> was specified.
This library is useful for the C<find2perl> tool, which when fed,
find2perl / -name .nfs\* -mtime +7 \
- -exec rm -f {} \; -o -fstype nfs -prune
+ -exec rm -f {} \; -o -fstype nfs -prune
produces something like:
sub wanted {
/^\.nfs.*$/ &&
- (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
int(-M _) > 7 &&
unlink($_)
||
- ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+ ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
$dev < 0 &&
($File::Find::prune = 1);
}
-Set the variable $File::Find::dont_use_nlink if you're using AFS,
+Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
since AFS cheats.
-C<finddepth> is just like C<find>, except that it does a depth-first
-search.
Here's another interesting wanted function. It will find all symlinks
that don't resolve:
sub wanted {
- -l && !-e && print "bogus link: $File::Find::name\n";
+ -l && !-e && print "bogus link: $File::Find::name\n";
}
-=head1 BUGS
+See also the script C<pfind> on CPAN for a nice application of this
+module.
+
+=head1 CAVEAT
+
+Be aware that the option to follow symblic links can be dangerous.
+Depending on the structure of the directory tree (including symbolic
+links to directories) you might traverse a given (physical) directory
+more than once (only if C<follow_fast> is in effect).
+Furthermore, deleting or changing files in a symbolically linked directory
+might cause very unpleasant surprises, since you delete or change files
+in an unknown directory.
-There is no way to make find or finddepth follow symlinks.
=cut
@EXPORT = qw(find finddepth);
-sub find_opt {
- my $wanted = shift;
- my $bydepth = $wanted->{bydepth};
- my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd();
- # Localize these rather than lexicalizing them for backwards
- # compatibility.
- local($topdir,$topdev,$topino,$topmode,$topnlink);
- foreach $topdir (@_) {
- (($topdev,$topino,$topmode,$topnlink) =
- ($Is_VMS ? stat($topdir) : lstat($topdir)))
- || (warn("Can't stat $topdir: $!\n"), next);
- if (-d _) {
- if (chdir($topdir)) {
- $prune = 0;
- unless ($bydepth) {
- ($dir,$_) = ($topdir,'.');
- $name = $topdir;
- $wanted->{wanted}->();
- }
- next if $prune;
- my $fixtopdir = $topdir;
- $fixtopdir =~ s,/$,, ;
- $fixtopdir =~ s/\.dir$// if $Is_VMS;
- &finddir($wanted,$fixtopdir,$topnlink, $bydepth);
- if ($bydepth) {
- ($dir,$_) = ($fixtopdir,'.');
- $name = $fixtopdir;
- $wanted->{wanted}->();
- }
+use strict;
+my $Is_VMS;
+
+require File::Basename;
+
+my %SLnkSeen;
+my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
+ $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat);
+
+sub contract_name {
+ my ($cdir,$fn) = @_;
+
+ return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.';
+
+ $cdir = substr($cdir,0,rindex($cdir,'/')+1);
+
+ $fn =~ s|^\./||;
+
+ my $abs_name= $cdir . $fn;
+
+ if (substr($fn,0,3) eq '../') {
+ do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|);
+ }
+
+ return $abs_name;
+}
+
+
+sub PathCombine($$) {
+ my ($Base,$Name) = @_;
+ my $AbsName;
+
+ if (substr($Name,0,1) eq '/') {
+ $AbsName= $Name;
+ }
+ else {
+ $AbsName= contract_name($Base,$Name);
+ }
+
+ # (simple) check for recursion
+ my $newlen= length($AbsName);
+ if ($newlen <= length($Base)) {
+ if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
+ && $AbsName eq substr($Base,0,$newlen))
+ {
+ return undef;
+ }
+ }
+ return $AbsName;
+}
+
+sub Follow_SymLink($) {
+ my ($AbsName) = @_;
+
+ my ($NewName,$DEV, $INO);
+ ($DEV, $INO)= lstat $AbsName;
+
+ while (-l _) {
+ if ($SLnkSeen{$DEV, $INO}++) {
+ if ($follow_skip < 2) {
+ die "$AbsName is encountered a second time";
}
else {
- warn "Can't cd to $topdir: $!\n";
+ return undef;
}
}
- else {
- require File::Basename;
- unless (($_,$dir) = File::Basename::fileparse($topdir)) {
- ($dir,$_) = ('.', $topdir);
+ $NewName= PathCombine($AbsName, readlink($AbsName));
+ unless(defined $NewName) {
+ if ($follow_skip < 2) {
+ die "$AbsName is a recursive symbolic link";
+ }
+ else {
+ return undef;
}
- if (chdir($dir)) {
- $name = $topdir;
- $wanted->{wanted}->();
+ }
+ else {
+ $AbsName= $NewName;
+ }
+ ($DEV, $INO) = lstat($AbsName);
+ return undef unless defined $DEV; # dangling symbolic link
+ }
+
+ if ($full_check && $SLnkSeen{$DEV, $INO}++) {
+ if ($follow_skip < 1) {
+ die "$AbsName encountered a second time";
+ }
+ else {
+ return undef;
+ }
+ }
+
+ return $AbsName;
+}
+
+use vars qw/ $dir $name $fullname $prune /;
+sub _find_dir_symlnk($$$);
+sub _find_dir($$$);
+
+sub _find_opt {
+ my $wanted = shift;
+ die "invalid top directory" unless defined $_[0];
+
+ my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
+ my $cwd_untainted = $cwd;
+ $wanted_callback = $wanted->{wanted};
+ $bydepth = $wanted->{bydepth};
+ $no_chdir = $wanted->{no_chdir};
+ $full_check = $wanted->{follow};
+ $follow = $full_check || $wanted->{follow_fast};
+ $follow_skip = $wanted->{follow_skip};
+ $untaint = $wanted->{untaint};
+ $untaint_pat = $wanted->{untaint_pattern};
+ $untaint_skip = $wanted->{untaint_skip};
+
+
+ # a symbolic link to a directory doesn't increase the link count
+ $avoid_nlink = $follow || $File::Find::dont_use_nlink;
+
+ if ( $untaint ) {
+ $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|;
+ die "insecure cwd in find(depth)" unless defined($cwd_untainted);
+ }
+
+ my ($abs_dir, $nlink, $Is_Dir);
+
+ Proc_Top_Item:
+ foreach my $TOP (@_) {
+ my $top_item = $TOP;
+ $top_item =~ s|/$||;
+ $Is_Dir= 0;
+
+ if ($follow) {
+ if (substr($top_item,0,1) eq '/') {
+ $abs_dir = $top_item;
+ }
+ elsif ($top_item eq '.') {
+ $abs_dir = $cwd;
}
+ else { # care about any ../
+ $abs_dir = contract_name("$cwd/",$top_item);
+ }
+ $abs_dir= Follow_SymLink($abs_dir);
+ unless (defined $abs_dir) {
+ warn "$top_item is a dangling symbolic link\n";
+ next Proc_Top_Item;
+ }
+ if (-d _) {
+ _find_dir_symlnk($wanted, $abs_dir, $top_item);
+ $Is_Dir= 1;
+ }
+ }
+ else { # no follow
+ $nlink = (lstat $top_item)[3];
+ unless (defined $nlink) {
+ warn "Can't stat $top_item: $!\n";
+ next Proc_Top_Item;
+ }
+ if (-d _) {
+ $top_item =~ s/\.dir$// if $Is_VMS;
+ _find_dir($wanted, $top_item, $nlink);
+ $Is_Dir= 1;
+ }
else {
- warn "Can't cd to $dir: $!\n";
+ $abs_dir= $top_item;
+ }
+ }
+
+ unless ($Is_Dir) {
+ unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
+ ($dir,$_) = ('.', $top_item);
+ }
+
+ $abs_dir = $dir;
+ if ($untaint) {
+ my $abs_dir_save = $abs_dir;
+ $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|;
+ unless (defined $abs_dir) {
+ if ($untaint_skip == 0) {
+ die "directory $abs_dir_save is still tainted";
+ }
+ else {
+ next Proc_Top_Item;
+ }
+ }
+ }
+
+ unless ($no_chdir or chdir $abs_dir) {
+ warn "Couldn't chdir $abs_dir: $!\n";
+ next Proc_Top_Item;
+ }
+
+ $name = $abs_dir;
+
+ &$wanted_callback;
+
+ }
+
+ $no_chdir or chdir $cwd_untainted;
+ }
+}
+
+# API:
+# $wanted
+# $p_dir : "parent directory"
+# $nlink : what came back from the stat
+# preconditions:
+# chdir (if not no_chdir) to dir
+
+sub _find_dir($$$) {
+ my ($wanted, $p_dir, $nlink) = @_;
+ my ($CdLvl,$Level) = (0,0);
+ my @Stack;
+ my @filenames;
+ my ($subcount,$sub_nlink);
+ my $SE= [];
+ my $dir_name= $p_dir;
+ my $dir_rel= '.'; # directory name relative to current directory
+
+ local ($dir, $name, $prune, *DIR);
+
+ unless ($no_chdir or $p_dir eq '.') {
+ my $udir = $p_dir;
+ if ($untaint) {
+ $udir = $1 if $p_dir =~ m|$untaint_pat|;
+ unless (defined $udir) {
+ if ($untaint_skip == 0) {
+ die "directory $p_dir is still tainted";
+ }
+ else {
+ return;
+ }
}
}
+ unless (chdir $udir) {
+ warn "Can't cd to $udir: $!\n";
+ return;
+ }
+ }
+
+ while (defined $SE) {
+ unless ($bydepth) {
+ $dir= $p_dir;
+ $name= $dir_name;
+ $_= ($no_chdir ? $dir_name : $dir_rel );
+ # prune may happen here
+ $prune= 0;
+ &$wanted_callback;
+ next if $prune;
+ }
+
+ # change to that directory
+ unless ($no_chdir or $dir_rel eq '.') {
+ my $udir= $dir_rel;
+ if ($untaint) {
+ $udir = $1 if $dir_rel =~ m|$untaint_pat|;
+ unless (defined $udir) {
+ if ($untaint_skip == 0) {
+ die "directory ($p_dir/) $dir_rel is still tainted";
+ }
+ }
+ }
+ unless (chdir $udir) {
+ warn "Can't cd to ($p_dir/) $udir : $!\n";
+ next;
+ }
+ $CdLvl++;
+ }
+
+ $dir= $dir_name;
+
+ # Get the list of files in the current directory.
+ unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
+ warn "Can't opendir($dir_name): $!\n";
+ next;
+ }
+ @filenames = readdir DIR;
+ closedir(DIR);
+
+ if ($nlink == 2 && !$avoid_nlink) {
+ # This dir has no subdirectories.
+ for my $FN (@filenames) {
+ next if $FN =~ /^\.{1,2}$/;
+
+ $name = "$dir_name/$FN";
+ $_ = ($no_chdir ? $name : $FN);
+ &$wanted_callback;
+ }
+
+ }
+ else {
+ # This dir has subdirectories.
+ $subcount = $nlink - 2;
+
+ for my $FN (@filenames) {
+ next if $FN =~ /^\.{1,2}$/;
+ if ($subcount > 0 || $avoid_nlink) {
+ # Seen all the subdirs?
+ # check for directoriness.
+ # stat is faster for a file in the current directory
+ $sub_nlink = (lstat ($no_chdir ? "$dir_name/$FN" : $FN))[3];
+
+ if (-d _) {
+ --$subcount;
+ $FN =~ s/\.dir$// if $Is_VMS;
+ push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
+ }
+ else {
+ $name = "$dir_name/$FN";
+ $_= ($no_chdir ? $name : $FN);
+ &$wanted_callback;
+ }
+ }
+ else { $name = "$dir_name/$FN";
+ $_= ($no_chdir ? $name : $FN);
+ &$wanted_callback;
+ }
+ }
+ }
+ if ($bydepth) {
+ $name = $dir_name;
+ $dir = $p_dir;
+ $_ = ($no_chdir ? $dir_name : $dir_rel );
+ &$wanted_callback;
+ }
}
continue {
- chdir $cwd;
+ if ( defined ($SE = pop @Stack) ) {
+ ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
+ if ($CdLvl > $Level && !$no_chdir) {
+ die "Can't cd to $dir_name" . '../' x ($CdLvl-$Level)
+ unless chdir '../' x ($CdLvl-$Level);
+ $CdLvl = $Level;
+ }
+ $dir_name = "$p_dir/$dir_rel";
+ }
}
}
-sub finddir {
- my($wanted, $nlink, $bydepth);
- local($dir, $name);
- ($wanted, $dir, $nlink, $bydepth) = @_;
-
- my($dev, $ino, $mode, $subcount);
-
- # Get the list of files in the current directory.
- opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return);
- my(@filenames) = readdir(DIR);
- closedir(DIR);
-
- if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories.
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $name = "$dir/$_";
- $nlink = 0;
- $wanted->{wanted}->();
- }
- }
- else { # This dir has subdirectories.
- $subcount = $nlink - 2;
- for (@filenames) {
- next if $_ eq '.';
- next if $_ eq '..';
- $nlink = 0;
- $prune = 0 unless $bydepth;
- $name = "$dir/$_";
- $wanted->{wanted}->() unless $bydepth;
- if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs?
-
- # Get link count and check for directoriness.
-
- $_ = "" if (!defined($_));
- ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
- # unless ($nlink || $dont_use_nlink);
-
- if (-d _) {
-
- # It really is a directory, so do it recursively.
-
- --$subcount;
- next if $prune;
- if (chdir $_) {
- $name =~ s/\.dir$// if $Is_VMS;
- &finddir($wanted,$name,$nlink, $bydepth);
- chdir '..';
+
+# API:
+# $wanted
+# $dir_loc : absolute location of a dir
+# $p_dir : "parent directory"
+# preconditions:
+# chdir (if not no_chdir) to dir
+
+sub _find_dir_symlnk($$$) {
+ my ($wanted, $dir_loc, $p_dir) = @_;
+ my @Stack;
+ my @filenames;
+ my $new_loc;
+ my $SE = [];
+ my $dir_name = $p_dir;
+ my $dir_rel = '.'; # directory name relative to current directory
+
+ local ($dir, $name, $fullname, $prune, *DIR);
+
+ unless ($no_chdir or $p_dir eq '.') {
+ my $udir = $dir_loc;
+ if ($untaint) {
+ $udir = $1 if $dir_loc =~ m|$untaint_pat|;
+ unless (defined $udir) {
+ if ($untaint_skip == 0) {
+ die "directory $dir_loc is still tainted";
+ }
+ else {
+ return;
+ }
+ }
+ }
+ unless (chdir $udir) {
+ warn "Can't cd to $udir: $!\n";
+ return;
+ }
+ }
+
+ while (defined $SE) {
+
+ unless ($bydepth) {
+ $dir= $p_dir;
+ $name= $dir_name;
+ $_= ($no_chdir ? $dir_name : $dir_rel );
+ $fullname= $dir_loc;
+ # prune may happen here
+ $prune= 0;
+ &$wanted_callback;
+ next if $prune;
+ }
+
+ # change to that directory
+ unless ($no_chdir or $dir_rel eq '.') {
+ my $udir = $dir_loc;
+ if ($untaint) {
+ $udir = $1 if $dir_loc =~ m|$untaint_pat|;
+ unless (defined $udir ) {
+ if ($untaint_skip == 0) {
+ die "directory $dir_loc is still tainted";
}
else {
- warn "Can't cd to $_: $!\n";
+ next;
}
}
}
- $wanted->{wanted}->() if $bydepth;
+ unless (chdir $udir) {
+ warn "Can't cd to $udir: $!\n";
+ next;
+ }
+ }
+
+ $dir = $dir_name;
+
+ # Get the list of files in the current directory.
+ unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
+ warn "Can't opendir($dir_loc): $!\n";
+ next;
+ }
+ @filenames = readdir DIR;
+ closedir(DIR);
+
+ for my $FN (@filenames) {
+ next if $FN =~ /^\.{1,2}$/;
+
+ # follow symbolic links / do an lstat
+ $new_loc= Follow_SymLink("$dir_loc/$FN");
+
+ # ignore if invalid symlink
+ next unless defined $new_loc;
+
+ if (-d _) {
+ push @Stack,[$new_loc,$dir_name,$FN];
+ }
+ else {
+ $fullname = $new_loc;
+ $name = "$dir_name/$FN";
+ $_ = ($no_chdir ? $name : $FN);
+ &$wanted_callback;
+ }
+ }
+
+ if ($bydepth) {
+ $fullname = $dir_loc;
+ $name = $dir_name;
+ $_ = ($no_chdir ? $dir_name : $dir_rel);
+ &$wanted_callback;
+ }
+ }
+ continue {
+ if (defined($SE = pop @Stack)) {
+ ($dir_loc, $p_dir, $dir_rel) = @$SE;
+ $dir_name = "$p_dir/$dir_rel";
}
}
}
+
sub wrap_wanted {
- my $wanted = shift;
- ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted };
+ my $wanted = shift;
+ if ( ref($wanted) eq 'HASH' ) {
+ if ( $wanted->{follow} || $wanted->{follow_fast}) {
+ $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
+ }
+ if ( $wanted->{untaint} ) {
+ $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|
+ unless defined $wanted->{untaint_pattern};
+ $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
+ }
+ return $wanted;
+ }
+ else {
+ return { wanted => $wanted };
+ }
}
sub find {
- my $wanted = shift;
- find_opt(wrap_wanted($wanted), @_);
+ my $wanted = shift;
+ _find_opt(wrap_wanted($wanted), @_);
+ %SLnkSeen= (); # free memory
}
sub finddepth {
- my $wanted = wrap_wanted(shift);
- $wanted->{bydepth} = 1;
- find_opt($wanted, @_);
+ my $wanted = wrap_wanted(shift);
+ $wanted->{bydepth} = 1;
+ _find_opt($wanted, @_);
+ %SLnkSeen= (); # free memory
}
# These are hard-coded for now, but may move to hint files.
if ($^O eq 'VMS') {
- $Is_VMS = 1;
- $dont_use_nlink = 1;
+ $Is_VMS = 1;
+ $File::Find::dont_use_nlink = 1;
}
-$dont_use_nlink = 1
+$File::Find::dont_use_nlink = 1
if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
# Set dont_use_nlink in your hint file if your system's stat doesn't
# report the number of links in a directory as an indication
# of the number of files.
# See, e.g. hints/machten.sh for MachTen 2.2.
-unless ($dont_use_nlink) {
- require Config;
- $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+unless ($File::Find::dont_use_nlink) {
+ require Config;
+ $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
}
1;
-
my $parent = File::Basename::dirname($path);
# Allow for creation of new logical filesystems under VMS
if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
- push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+ unless (-d $parent or $path eq $parent) {
+ push(@created,mkpath($parent, $verbose, $mode));
+ }
}
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
- my $e = $!;
- # allow for another process to have created it meanwhile
- croak "mkdir $path: $e" unless -d $path;
+ my $e = $!;
+ # allow for another process to have created it meanwhile
+ croak "mkdir $path: $e" unless -d $path;
}
push(@created, $path);
}
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
-$VERSION = $VERSION = "1.42";
+$VERSION = "1.42";
BEGIN
{
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
-$VERSION = $VERSION = '1.01';
+$VERSION = '1.01';
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
=head1 AUTHORS
-Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
+Raphael Manfredi <F<Raphael_Manfredi@pobox.com>> and
Jarkko Hietaniemi <F<jhi@iki.fi>>.
Extensive patches by Daniel S. Lewart <F<d-lewart@uiuc.edu>>.
=head1 AUTHORS
Jarkko Hietaniemi <F<jhi@iki.fi>> and
-Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>.
+Raphael Manfredi <F<Raphael_Manfredi@pobox.com>>.
=cut
package Pod::Checker;
use vars qw($VERSION);
-$VERSION = 1.085; ## Current version of this package
+$VERSION = 1.090; ## Current version of this package
require 5.004; ## requires this Perl version or later
=head1 NAME
use Pod::Checker;
- $syntax_okay = podchecker($filepath, $outputpath);
+ $syntax_okay = podchecker($filepath, $outputpath, %options);
=head1 OPTIONS/ARGUMENTS
If unspecified, the input-file it defaults to C<\*STDIN>, and
the output-file defaults to C<\*STDERR>.
+=head2 Options
+
+=over 4
+
+=item B<-warnings> =E<gt> I<val>
+
+Turn warnings on/off. See L<"Warnings">.
+
+=back
=head1 DESCRIPTION
It is hoped that curious/ambitious user will help flesh out and add the
additional features they wish to see in B<Pod::Checker> and B<podchecker>.
+The following additional checks are preformed:
+
+=over 4
+
+=item *
+
+Check for proper balancing of C<=begin> and C<=end>.
+
+=item *
+
+Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.
+
+=item *
+
+Check for same nested interior-sequences (e.g. C<LE<lt>...LE<lt>...E<gt>...E<gt>>).
+
+=item *
+
+Check for malformed entities.
+
+=item *
+
+Check for correct syntax of hyperlinks C<LE<lt>E<gt>>. See L<perlpod> for
+details.
+
+=item *
+
+Check for unresolved document-internal links.
+
+=back
+
+=head2 Warnings
+
+The following warnings are printed. These may not necessarily cause trouble,
+but indicate mediocre style.
+
+=over 4
+
+=item *
+
+Spurious characters after C<=back> and C<=end>.
+
+=item *
+
+Unescaped C<E<lt>> and C<E<gt>> in the text.
+
+=item *
+
+Missing arguments for C<=begin> and C<=over>.
+
+=item *
+
+Empty C<=over> / C<=back> list.
+
+=item *
+
+Hyperlinks: leading/trailing whitespace, brackets C<()> in the page name.
+
+=back
+
+=head1 DIAGNOSTICS
+
+I<[T.B.D.]>
+
+=head1 RETURN VALUE
+
+B<podchecker> returns the number of POD syntax errors found or -1 if
+there were no POD commands at all found in the file.
+
=head1 EXAMPLES
I<[T.B.D.]>
=head1 AUTHOR
-Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version)
+Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
## Function definitions begin here
##---------------------------------
-sub podchecker( $ ; $ ) {
- my ($infile, $outfile) = @_;
+sub podchecker( $ ; $ % ) {
+ my ($infile, $outfile, %options) = @_;
local $_;
## Set defaults
$outfile ||= \*STDERR;
## Now create a pod checker
- my $checker = new Pod::Checker();
+ my $checker = new Pod::Checker(%options);
## Now check the pod document for errors
$checker->parse_from_file($infile, $outfile);
## increment this number and then print to the designated output.
$self->{_NUM_ERRORS} = 0;
$self->errorsub('poderror');
+ $self->{_commands} = 0; # total number of POD commands encountered
+ $self->{_list_stack} = []; # stack for nested lists
+ $self->{_have_begin} = ''; # stores =begin
+ $self->{_links} = []; # stack for internal hyperlinks
+ $self->{_nodes} = []; # stack for =head/=item nodes
+ $self->{-warnings} = 1 unless(defined $self->{-warnings});
}
## Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
my $file = (exists $opts{-file}) ? " in file $opts{-file}" : "";
my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : "";
- ## Increment error count and print message
- ++($self->{_NUM_ERRORS});
+ ## Increment error count and print message "
+ ++($self->{_NUM_ERRORS})
+ if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
my $out_fh = $self->output_handle();
print $out_fh ($severity, $msg, $line, $file, "\n");
}
return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
}
+## overrides for Pod::Parser
+
sub end_pod {
- ## Print the number of errors found
+ ## Do some final checks and
+ ## print the number of errors found
my $self = shift;
my $infile = $self->input_file();
my $out_fh = $self->output_handle();
+ if(@{$self->{_list_stack}}) {
+ # _TODO_ display, but don't count them for now
+ my $list;
+ while($list = shift(@{$self->{_list_stack}})) {
+ $self->poderror({ -line => 'EOF', -file => $infile,
+ -severity => 'ERROR', -msg => "=over on line " .
+ $list->start() . " without closing =back" }); #"
+ }
+ }
+
+ # check validity of document internal hyperlinks
+ # first build the node names from the paragraph text
+ my %nodes;
+ foreach($self->node()) {
+ #print "Have node: +$_+\n";
+ $nodes{$_} = 1;
+ if(/^(\S+)\s+/) {
+ # we have more than one word. Use the first as a node, too.
+ # This is used heavily in perlfunc.pod
+ $nodes{$1} ||= 2; # derived node
+ }
+ }
+ foreach($self->hyperlink()) {
+ #print "Seek node: +$_+\n";
+ my $line = '';
+ s/^(\d+):// && ($line = $1);
+ if($_ && !$nodes{$_}) {
+ $self->poderror({ -line => $line, -file => $infile,
+ -severity => 'ERROR',
+ -msg => "unresolved internal link `$_'"});
+ }
+ }
+
+ ## Print the number of errors found
my $num_errors = $self->num_errors();
if ($num_errors > 0) {
printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
($num_errors == 1) ? "error" : "errors");
}
+ elsif($self->{_commands} == 0) {
+ print $out_fh "$infile does not contain any pod commands.\n";
+ $self->num_errors(-1);
+ }
else {
print $out_fh "$infile pod syntax OK.\n";
}
my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
my ($file, $line) = $pod_para->file_line;
## Check the command syntax
+ my $arg; # this will hold the command argument
if (! $VALID_COMMANDS{$cmd}) {
$self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
-msg => "Unknown command \"$cmd\"" });
}
else {
- ## check syntax of particular command
+ $self->{_commands}++; # found a valid command
+ ## check syntax of particular command
+ if($cmd eq 'over') {
+ # start a new list
+ unshift(@{$self->{_list_stack}},
+ Pod::List->new(
+ -indent => $paragraph,
+ -start => $line,
+ -file => $file));
+ }
+ elsif($cmd eq 'item') {
+ unless(@{$self->{_list_stack}}) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "=item without previous =over" });
+ }
+ else {
+ # check for argument
+ $arg = $self->_interpolate_and_check($paragraph, $line, $file);
+ unless($arg && $arg =~ /(\S+)/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "No argument for =item" });
+ }
+ # add this item
+ $self->{_list_stack}[0]->item($arg || '');
+ # remember this node
+ $self->node($arg) if($arg);
+ }
+ }
+ elsif($cmd eq 'back') {
+ # check if we have an open list
+ unless(@{$self->{_list_stack}}) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "=back without previous =over" });
+ }
+ else {
+ # check for spurious characters
+ $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+ if($arg && $arg =~ /\S/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "Spurious character(s) after =back" });
+ }
+ # close list
+ my $list = shift @{$self->{_list_stack}};
+ # check for empty lists
+ if(!$list->item() && $self->{-warnings}) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "No items in =over (at line " .
+ $list->start() . ") / =back list"}); #"
+ }
+ }
+ }
+ elsif($cmd =~ /^head/) {
+ # check if there is an open list
+ if(@{$self->{_list_stack}}) {
+ my $list;
+ while($list = shift(@{$self->{_list_stack}})) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "unclosed =over (line ". $list->start() .
+ ") at $cmd" });
+ }
+ }
+ # remember this node
+ $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+ $self->node($arg) if($arg);
+ }
+ elsif($cmd eq 'begin') {
+ if($self->{_have_begin}) {
+ # already have a begin
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "Nested =begin's (first at line " .
+ $self->{_have_begin} . ")"});
+ }
+ else {
+ # check for argument
+ $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+ unless($arg && $arg =~ /(\S+)/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "No argument for =begin"});
+ }
+ # remember the =begin
+ $self->{_have_begin} = "$line:$1";
+ }
+ }
+ elsif($cmd eq 'end') {
+ if($self->{_have_begin}) {
+ # close the existing =begin
+ $self->{_have_begin} = '';
+ # check for spurious characters
+ $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+ if($arg && $arg =~ /\S/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "Spurious character(s) after =end" });
+ }
+ }
+ else {
+ # don't have a matching =begin
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "=end without =begin" });
+ }
+ }
}
- my $expansion = $self->interpolate($paragraph, $line_num);
+ ## Check the interior sequences in the command-text
+ $self->_interpolate_and_check($paragraph, $line,$file)
+ unless(defined $arg);
}
+sub _interpolate_and_check {
+ my ($self, $paragraph, $line, $file) = @_;
+ ## Check the interior sequences in the command-text
+ # and return the text
+ $self->_check_ptree(
+ $self->parse_text($paragraph,$line), $line, $file, '');
+}
+
+sub _check_ptree {
+ my ($self,$ptree,$line,$file,$nestlist) = @_;
+ local($_);
+ my $text = '';
+ # process each node in the parse tree
+ foreach(@$ptree) {
+ # regular text chunk
+ unless(ref) {
+ my $count;
+ # count the unescaped angle brackets
+ my $i = $_;
+ if($count = $i =~ s/[<>]/$self->expand_unescaped_bracket($&)/ge) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "$count unescaped <>" });
+ }
+ $text .= $i;
+ next;
+ }
+ # have an interior sequence
+ my $cmd = $_->cmd_name();
+ my $contents = $_->parse_tree();
+ ($file,$line) = $_->file_line();
+ # check for valid tag
+ if (! $VALID_SEQUENCES{$cmd}) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => qq(Unknown interior-sequence "$cmd")});
+ # expand it anyway
+ $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+ next;
+ }
+ if($nestlist =~ /$cmd/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "nested commands $cmd<...$cmd<...>...>"});
+ # _TODO_ should we add the contents anyway?
+ # expand it anyway, see below
+ }
+ if($cmd eq 'E') {
+ # preserve entities
+ if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "garbled entity " . $_->raw_text()});
+ next;
+ }
+ $text .= $self->expand_entity($$contents[0]);
+ }
+ elsif($cmd eq 'L') {
+ # try to parse the hyperlink
+ my $link = Pod::Hyperlink->new($contents->raw_text());
+ unless(defined $link) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "malformed link L<>: $@"});
+ next;
+ }
+ $link->line($line); # remember line
+ if($self->{-warnings}) {
+ foreach my $w ($link->warning()) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => $w });
+ }
+ }
+ # check the link text
+ $text .= $self->_check_ptree($self->parse_text($link->text(),
+ $line), $line, $file, "$nestlist$cmd");
+ my $node = '';
+ $node = $self->_check_ptree($self->parse_text($link->node(),
+ $line), $line, $file, "$nestlist$cmd")
+ if($link->node());
+ # store internal link
+ # _TODO_ what if there is a link to the page itself by the name,
+ # e.g. Tk::Pod : L<Tk::Pod/"DESCRIPTION">
+ $self->hyperlink("$line:$node") if($node && !$link->page());
+ }
+ elsif($cmd =~ /[BCFIS]/) {
+ # add the guts
+ $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+ }
+ else {
+ # check, but add nothing to $text (X<>, Z<>)
+ $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+ }
+ }
+ $text;
+}
+
+# default method - just return it
+sub expand_unescaped_bracket {
+ my ($self,$bracket) = @_;
+ $bracket;
+}
+
+# keep the entities
+sub expand_entity {
+ my ($self,$entity) = @_;
+ "E<$entity>";
+}
+
+# _TODO_ overloadable methods for BC..Z<...> expansion
+
sub verbatim {
## Nothing to check
## my ($self, $paragraph, $line_num, $pod_para) = @_;
sub textblock {
my ($self, $paragraph, $line_num, $pod_para) = @_;
- my $expansion = $self->interpolate($paragraph, $line_num);
+ my ($file, $line) = $pod_para->file_line;
+ $self->_interpolate_and_check($paragraph, $line,$file);
}
-sub interior_sequence {
- my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
- my ($file, $line) = $pod_seq->file_line;
- ## Check the sequence syntax
- if (! $VALID_SEQUENCES{$seq_cmd}) {
- $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
- -msg => "Unknown interior-sequence \"$seq_cmd\"" });
+# set/return nodes of the current POD
+sub node {
+ my ($self,$text) = @_;
+ if(defined $text) {
+ $text =~ s/[\s\n]+$//; # strip trailing whitespace
+ # add node
+ push(@{$self->{_nodes}}, $text);
+ return $text;
+ }
+ @{$self->{_nodes}};
+}
+
+# set/return hyperlinks of the current POD
+sub hyperlink {
+ my $self = shift;
+ if($_[0]) {
+ push(@{$self->{_links}}, $_[0]);
+ return $_[0];
+ }
+ @{$self->{_links}};
+}
+
+#-----------------------------------------------------------------------------
+# Pod::List
+#
+# class to hold POD list info (=over, =item, =back)
+#-----------------------------------------------------------------------------
+
+package Pod::List;
+
+use Carp;
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my %params = @_;
+ my $self = {%params};
+ bless $self, $class;
+ $self->initialize();
+ return $self;
+}
+
+sub initialize {
+ my $self = shift;
+ $self->{-file} ||= 'unknown';
+ $self->{-start} ||= 'unknown';
+ $self->{-indent} ||= 4; # perlpod: "should be the default"
+ $self->{_items} = [];
+}
+
+# The POD file name the list appears in
+sub file {
+ return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
+}
+
+# The line in the file the node appears
+sub start {
+ return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
+}
+
+# indent level
+sub indent {
+ return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
+}
+
+# The individual =items of this list
+sub item {
+ my ($self,$item) = @_;
+ if(defined $item) {
+ push(@{$self->{_items}}, $item);
+ return $item;
}
else {
- ## check syntax of the particular sequence
+ return @{$self->{_items}};
}
}
+#-----------------------------------------------------------------------------
+# Pod::Hyperlink
+#
+# class to hold hyperlinks (L<>)
+#-----------------------------------------------------------------------------
+
+package Pod::Hyperlink;
+
+=head1 NAME
+
+Pod::Hyperlink - class for manipulation of POD hyperlinks
+
+=head1 SYNOPSIS
+
+ my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
+
+=head1 DESCRIPTION
+
+The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
+C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
+different parts of a POD hyperlink.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+The B<new()> method can either be passed a set of key/value pairs or a single
+scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
+of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
+failure, the error message is stored in C<$@>.
+
+=item parse()
+
+This method can be used to (re)parse a (new) hyperlink. The result is stored
+in the current object.
+
+=item markup($on,$off,$pageon,$pageoff)
+
+The result of this method is a string the represents the textual value of the
+link, but with included arbitrary markers that highlight the active portion
+of the link. This will mainly be used by POD translators and saves the
+effort of determining which words have to be highlighted. Examples: Depending
+on the type of link, the following text will be returned, the C<*> represent
+the places where the section/item specific on/off markers will be placed
+(link to a specific node) and C<+> for the pageon/pageoff markers (link to the
+top of the page).
+
+ the +perl+ manpage
+ the *$|* entry in the +perlvar+ manpage
+ the section on *OPTIONS* in the +perldoc+ manpage
+ the section on *DESCRIPTION* elsewhere in this document
+
+This method is read-only.
+
+=item text()
+
+This method returns the textual representation of the hyperlink as above,
+but without markers (read only).
+
+=item warning()
+
+After parsing, this method returns any warnings ecountered during the
+parsing process.
+
+=item page()
+
+This method sets or returns the POD page this link points to.
+
+=item node()
+
+As above, but the destination node text of the link.
+
+=item type()
+
+The node type, either C<section> or C<item>.
+
+=item alttext()
+
+Sets or returns an alternative text specified in the link.
+
+=item line(), file()
+
+Just simple slots for storing information about the line and the file
+the link was incountered in. Has to be filled in manually.
+
+=back
+
+=head1 AUTHOR
+
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing
+a lot of things from L<pod2man> and L<pod2roff>.
+
+=cut
+
+use Carp;
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = +{};
+ bless $self, $class;
+ $self->initialize();
+ if(defined $_[0]) {
+ if(ref($_[0])) {
+ # called with a list of parameters
+ %$self = %{$_[0]};
+ }
+ else {
+ # called with L<> contents
+ return undef unless($self->parse($_[0]));
+ }
+ }
+ return $self;
+}
+
+sub initialize {
+ my $self = shift;
+ $self->{-line} ||= 'undef';
+ $self->{-file} ||= 'undef';
+ $self->{-page} ||= '';
+ $self->{-node} ||= '';
+ $self->{-alttext} ||= '';
+ $self->{-type} ||= 'undef';
+ $self->{_warnings} = [];
+ $self->_construct_text();
+}
+
+sub parse {
+ my $self = shift;
+ local($_) = $_[0];
+ # syntax check the link and extract destination
+ my ($alttext,$page,$section,$item) = ('','','','');
+
+ # strip leading/trailing whitespace
+ if(s/^[\s\n]+//) {
+ $self->warning("ignoring leading whitespace in link");
+ }
+ if(s/[\s\n]+$//) {
+ $self->warning("ignoring trailing whitespace in link");
+ }
+
+ # collapse newlines with whitespace
+ s/\s*\n\s*/ /g;
+
+ # extract alternative text
+ if(s!^([^|/"\n]*)[|]!!) {
+ $alttext = $1;
+ }
+ # extract page
+ if(s!^([^|/"\s]*)(?=/|$)!!) {
+ $page = $1;
+ }
+ # extract section
+ if(s!^/?"([^"\n]+)"$!!) { # e.g. L</"blah blah">
+ $section = $1;
+ }
+ # extact item
+ if(s!^/(.*)$!!) {
+ $item = $1;
+ }
+ # last chance here
+ if(s!^([^|"\s\n/][^"\n/]*)$!!) { # e.g. L<lah di dah>
+ $section = $1;
+ }
+ # now there should be nothing left
+ if(length) {
+ _invalid_link("garbled entry (spurious characters `$_')");
+ return undef;
+ }
+ elsif(!(length($page) || length($section) || length($item))) {
+ _invalid_link("empty link");
+ return undef;
+ }
+ elsif($alttext =~ /[<>]/) {
+ _invalid_link("alternative text contains < or >");
+ return undef;
+ }
+ else { # no errors so far
+ if($page =~ /[(]\d\w*[)]$/) {
+ $self->warning("brackets in `$page'");
+ $page = $`; # strip that extension
+ }
+ if($page =~ /^(\s*)(\S+)(\s*)/ && (length($1) || length($3))) {
+ $self->warning("whitespace in `$page'");
+ $page = $2; # strip that extension
+ }
+ }
+ $self->page($page);
+ $self->node($section || $item); # _TODO_ do not distinguish for now
+ $self->alttext($alttext);
+ $self->type($item ? 'item' : 'section');
+ 1;
+}
+
+sub _construct_text {
+ my $self = shift;
+ my $alttext = $self->alttext();
+ my $type = $self->type();
+ my $section = $self->node();
+ my $page = $self->page();
+ $self->{_text} =
+ $alttext ? $alttext : (
+ !$section ? '' :
+ $type eq 'item' ? 'the ' . $section . ' entry' :
+ 'the section on ' . $section ) .
+ ($page ? ($section ? ' in ':''). 'the ' . $page . ' manpage' :
+ 'elsewhere in this document');
+ # for being marked up later
+ $self->{_markup} =
+ $alttext ? '<SECTON>' . $alttext . '<SECTOFF>' : (
+ !$section ? '' :
+ $type eq 'item' ? 'the <SECTON>' . $section . '<SECTOFF> entry' :
+ 'the section on <SECTON>' . $section . '<SECTOFF>' ) .
+ ($page ? ($section ? ' in ':'') . 'the <PAGEON>' .
+ $page . '<PAGEOFF> manpage' :
+ ' elsewhere in this document');
+}
+
+# include markup
+sub markup {
+ my ($self,$on,$off,$pageon,$pageoff) = @_;
+ $on ||= '';
+ $off ||= '';
+ $pageon ||= '';
+ $pageoff ||= '';
+ $_[0]->_construct_text;
+ my $str = $self->{_markup};
+ $str =~ s/<SECTON>/$on/;
+ $str =~ s/<SECTOFF>/$off/;
+ $str =~ s/<PAGEON>/$pageon/;
+ $str =~ s/<PAGEOFF>/$pageoff/;
+ return $str;
+}
+
+# The complete link's text
+sub text {
+ $_[0]->_construct_text();
+ $_[0]->{_text};
+}
+
+# The POD page the link appears on
+sub warning {
+ my $self = shift;
+ if(@_) {
+ push(@{$self->{_warnings}}, @_);
+ return @_;
+ }
+ return @{$self->{_warnings}};
+}
+
+# The POD file name the link appears in
+sub file {
+ return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
+}
+
+# The line in the file the link appears
+sub line {
+ return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
+}
+
+# The POD page the link appears on
+sub page {
+ return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
+}
+
+# The link destination
+sub node {
+ return (@_ > 1) ? ($_[0]->{-node} = $_[1]) : $_[0]->{-node};
+}
+
+# Potential alternative text
+sub alttext {
+ return (@_ > 1) ? ($_[0]->{-alttext} = $_[1]) : $_[0]->{-alttext};
+}
+
+# The type
+sub type {
+ return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
+}
+
+sub _invalid_link {
+ my ($msg) = @_;
+ # this sets @_
+ #eval { die "$msg\n" };
+ #chomp $@;
+ $@ = $msg; # this seems to work, too!
+ undef;
+}
+
+1;
if (m,^(.*?)/"?(.*?)"?$,) { # yes
($page, $section) = ($1, $2);
} else { # no
- ($page, $section) = ($str, "");
+ ($page, $section) = ($_, "");
}
# check if we know that this is a section in this page
package Pod::InputObjects;
use vars qw($VERSION);
-$VERSION = 1.085; ## Current version of this package
+$VERSION = 1.090; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
package Pod::Parser;
use vars qw($VERSION);
-$VERSION = 1.085; ## Current version of this package
+$VERSION = 1.091; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
of the POD-format documentation are not made available to the caller
(not even using B<preprocess_paragraph()>). Setting this option to a
non-empty, non-zero value will allow B<preprocess_paragraph()> to see
-non-POD sectioins of the input as well as POD sections. The B<cutting()>
+non-POD sections of the input as well as POD sections. The B<cutting()>
method can be used to determine if the corresponding paragraph is a POD
paragraph, or some other input paragraph.
place If the empty string is returned or an undefined value is
returned, then the given C<$text> is ignored (not processed).
-This method is invoked after gathering up all thelines in a paragraph
+This method is invoked after gathering up all the lines in a paragraph
+and after determining the cutting state of the paragraph,
but before trying to further parse or interpret them. After
B<preprocess_paragraph()> returns, the current cutting state (which
is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
-to false then input text (including the given C<$text>) is cut (not
+to true then input text (including the given C<$text>) is cut (not
processed) until the next POD directive is encountered.
Please note that the B<preprocess_line()> method is invoked I<before>
the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and it has been
+lines in a paragraph have been assembled together and either it has been
determined that the paragraph is part of the POD documentation from one
-of the selected sections, then B<preprocess_paragraph()> is invoked.
+of the selected sections or the C<-want_nonPODs> option is true,
+then B<preprocess_paragraph()> is invoked.
The base class implementation of this method returns the given text.
local $_;
## See if we want to preprocess nonPOD paragraphs as well as POD ones.
- my $wantNonPods = $myOpts{'-want_nonPODs'} || 0;
+ my $wantNonPods = $myOpts{'-want_nonPODs'};
+
+ ## Update cutting status
+ $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
## Perform any desired preprocessing if we wanted it this early
$wantNonPods and $text = $self->preprocess_paragraph($text, $line_num);
- ## This is the end of a non-empty paragraph
## Ignore up until next POD directive if we are cutting
- if ($myData{_CUTTING}) {
- return unless ($text =~ /^={1,2}\S/);
- $myData{_CUTTING} = 0;
- }
+ return if $myData{_CUTTING};
## Now we know this is block of text in a POD section!
my $errorsub = $parser->errorsub()
my $errmsg = "This is an error message!\n"
(ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errmsg) and $parser->$errorsub($errmsg)
+ or (defined $errorsub) and $parser->$errorsub($errmsg)
or warn($errmsg);
Returns a method name, or else a reference to the user-supplied subroutine
package Pod::Select;
use vars qw($VERSION);
-$VERSION = 1.085; ## Current version of this package
+$VERSION = 1.090; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
package Pod::Usage;
use vars qw($VERSION);
-$VERSION = 1.085; ## Current version of this package
+$VERSION = 1.090; ## Current version of this package
require 5.004; ## requires this Perl version or later
=head1 NAME
@ISA = qw( Exporter );
@EXPORT = qw( timegm timelocal );
-@EXPORT_OK = qw( $no_range_check );
-
-sub import {
- my $package = shift;
- my @args;
- for (@_) {
- $no_range_check = 1, next if $_ eq 'no_range_check';
- push @args, $_;
- }
- Time::Local->export_to_level(1, $package, @args);
-}
+@EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
# Set up constants
$SEC = 1;
$breakpoint = ($thisYear + 50) % 100;
$nextCentury += 100 if $breakpoint < 50;
+my %options;
+
sub timegm {
my (@date) = @_;
if ($date[5] > 999) {
+ ($date[3]-1) * $DAY;
}
+sub timegm_nocheck {
+ local $options{no_range_check} = 1;
+ &timegm;
+}
+
sub timelocal {
my $t = &timegm;
my $tt = $t;
$time;
}
+sub timelocal_nocheck {
+ local $options{no_range_check} = 1;
+ &timelocal;
+}
+
sub cheat {
$year = $_[5];
$month = $_[4];
- unless ($no_range_check) {
+ unless ($options{no_range_check}) {
croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0;
croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1;
croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0;
the range 1..31, the month should be in the range 0..11.
This is consistent with the values returned from localtime() and gmtime().
-Also worth noting is the ability to disable the range checking that
-would normally occur on the input $sec, $min, $hours, $mday, and $mon
-values. You can do this by setting $Time::Local::no_range_check = 1,
-or by invoking the module with C<use Time::Local 'no_range_check'>.
-This enables you to abuse the terminology somewhat and gain the
-flexibilty to do things like:
+The timelocal() and timegm() functions perform range checking on the
+input $sec, $min, $hours, $mday, and $mon values by default. If you'd
+rather they didn't, you can explicitly import the timelocal_nocheck()
+and timegm_nocheck() functions.
- use Time::Local qw( no_range_check );
+ use Time::Local 'timelocal_nocheck';
+
+ {
+ # The 365th day of 1999
+ print scalar localtime timelocal_nocheck 0,0,0,365,0,99;
- # The 365th day of 1999
- print scalar localtime timelocal 0,0,0,365,0,99;
+ # The twenty thousandth day since 1970
+ print scalar localtime timelocal_nocheck 0,0,0,20000,0,70;
- # The twenty thousandth day since 1970
- print scalar localtime timelocal 0,0,0,20000,0,70;
-
- # And even the 10,000,000th second since 1999!
- print scalar localtime timelocal 10000000,0,0,1,0,99;
+ # And even the 10,000,000th second since 1999!
+ print scalar localtime timelocal_nocheck 10000000,0,0,1,0,99;
+ }
-Your mileage may vary when trying this trick with minutes and hours,
+Your mileage may vary when trying these with minutes and hours,
and it doesn't work at all for months.
Strictly speaking, the year should also be specified in a form consistent
@trypod = (
"$archlib/pod/perldiag.pod",
"$privlib/pod/perldiag-$].pod",
- "$privlib/pod/perldiag.pod"
+ "$privlib/pod/perldiag.pod",
"$archlib/pods/perldiag.pod",
"$privlib/pods/perldiag-$].pod",
- "$privlib/pods/perldiag.pod"
+ "$privlib/pods/perldiag.pod",
);
# handy for development testing of new warnings etc
unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.0403;
+$VERSION = 1.04041;
$header = "perl5db.pl version $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
# LineInfo - file or pipe to print line number info to. If it is a
# pipe, a short "emacs like" message is used.
#
+# RemotePort - host:port to connect to on remote host for remote debugging.
+#
# Example $rcfile: (delete leading hashes!)
#
# &parse_options("NonStop=1 LineInfo=db.out");
TTY noTTY ReadLine NonStop LineInfo maxTraceLen
recallCommand ShellBang pager tkRunning ornaments
signalLevel warnLevel dieLevel inhibit_exit
- ImmediateStop bareStringify);
+ ImmediateStop bareStringify
+ RemotePort);
%optionVars = (
hashDepth => \$dumpvar::hashDepth,
inhibit_exit => \$inhibit_exit,
maxTraceLen => \$maxtrace,
ImmediateStop => \$ImmediateStop,
+ RemotePort => \$remoteport,
);
%optionAction = (
dieLevel => \&dieLevel,
tkRunning => \&tkRunning,
ornaments => \&ornaments,
+ RemotePort => \&RemotePort,
);
%optionRequire = (
$console = $tty if defined $tty;
- if (defined $console) {
- open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
- open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
- || open(OUT,">&STDOUT"); # so we don't dongle stdout
- } else {
- open(IN,"<&STDIN");
- open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
- $console = 'STDIN/OUT';
+ if (defined $remoteport) {
+ require IO::Socket;
+ $OUT = new IO::Socket::INET( Timeout => '10',
+ PeerAddr => $remoteport,
+ Proto => 'tcp',
+ );
+ if (!$OUT) { die "Could not create socket to connect to remote host."; }
+ $IN = $OUT;
}
- # so open("|more") can read from STDOUT and so we don't dingle stdin
- $IN = \*IN;
+ else {
+ if (defined $console) {
+ open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
+ open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
+ || open(OUT,">&STDOUT"); # so we don't dongle stdout
+ } else {
+ open(IN,"<&STDIN");
+ open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
+ $console = 'STDIN/OUT';
+ }
+ # so open("|more") can read from STDOUT and so we don't dingle stdin
+ $IN = \*IN;
- $OUT = \*OUT;
+ $OUT = \*OUT;
+ }
select($OUT);
$| = 1; # for DB::OUT
select(STDOUT);
B<h q>, B<h R> or B<h O> to get additional info.
EOP
$package = 'main';
- $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+ $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
"package $package;"; # this won't let them modify, alas
} else {
$sub =~ s/\'/::/;
}
local $frame = 0;
local $doret = -2;
- $term->readline(@_);
+ if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
+ print $OUT @_;
+ my $stuff;
+ $IN->recv( $stuff, 2048 );
+ $stuff;
+ }
+ else {
+ $term->readline(@_);
+ }
}
sub dump_option {
$rl;
}
+sub RemotePort {
+ if ($term) {
+ &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_;
+ }
+ $remoteport = shift if @_;
+ $remoteport;
+}
+
sub tkRunning {
if ($ {$term->Features}{tkRunning}) {
return $term->tkRunning(@_);
I<signalLevel> I<warnLevel> I<dieLevel>: level of verbosity;
I<inhibit_exit> Allows stepping off the end of the script.
I<ImmediateStop> Debugger should stop as early as possible.
+ I<RemotePort>: Remote hostname:port for remote debugging
The following options affect what happens with B<V>, B<X>, and B<x> commands:
I<arrayDepth>, I<hashDepth>: print only first N elements ('' for all);
I<compactDump>, I<veryCompact>: change style of array and hash dump;
I<ornaments> affects screen appearance of the command line.
During startup options are initialized from \$ENV{PERLDB_OPTS}.
You can put additional initialization options I<TTY>, I<noTTY>,
- I<ReadLine>, and I<NonStop> there (or use `B<R>' after you set them).
+ I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
+ `B<R>' after you set them).
B<<> I<expr> Define Perl command to run before each prompt.
B<<<> I<expr> Add to the list of Perl commands to run before each prompt.
B<>> I<expr> Define Perl command to run after each prompt.
The local() generated a compile-time error because you just touched a global
name without fully qualifying it.
+Because of their special use by sort(), the variables $a and $b are
+exempted from this check.
+
=item C<strict subs>
This disables the poetry optimization, generating a compile-time error if
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0622 0625 R
0626 D
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0622 0623 ALEF
0624 WAW
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 0008 BN
0009 S
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 007F Basic Latin
0080 00FF Latin-1 Supplement
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 001f Cc
0020 Zs
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0300 0314 230
0315 232
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00a0 <noBreak> 0020
00a8 <compat> 0020 0308
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+0041 00C0 00C1 00C2 00C3 00C4 00C5
+0043 00C7
+0045 00C8 00C9 00CA 00CB
+0049 00CC 00CD 00CE 00CF
+004E 00D1
+004F 00D2 00D3 00D4 00D5 00D6 00D8
+0055 00D9 00DA 00DB 00DC
+0059 00DD
+0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5
+0063 00E7
+0065 00E8 00E9 00EA 00EB
+0069 00EC 00ED 00EE 00EF
+006E 00F1
+006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8
+0075 00F9 00FA 00FB 00FC
+0079 00FD 00FF
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+0041 00C0 00C1 00C2 00C3 00C4 00C5 0100 0102 0104 01CD 0200 0202 0226 1E00 1EA0 1EA2 FF21
+0042 0181 0182 1E02 1E04 1E06 212C FF22
+0043 00C7 0106 0108 010A 010C 0187 2102 212D FF23
+0044 010E 0110 018A 018B 01C4 01C5 01F1 01F2 1E0A 1E0C 1E0E 1E10 1E12 FF24
+0045 00C8 00C9 00CA 00CB 0112 0114 0116 0118 011A 0204 0206 0228 1E18 1E1A 1EB8 1EBA 1EBC 2130 FF25
+0046 0191 1E1E 2131 FF26
+0047 011C 011E 0120 0122 0193 01E4 01E6 01F4 1E20 FF27
+0048 0124 0126 021E 1E22 1E24 1E26 1E28 1E2A 210B 210C 210D FF28
+0049 00CC 00CD 00CE 00CF 0128 012A 012C 012E 0130 0132 0197 01CF 0208 020A 1E2C 1EC8 1ECA 2110 2111 FF29
+004A 0134 FF2A
+004B 0136 0198 01E8 1E30 1E32 1E34 212A FF2B
+004C 0139 013B 013D 013F 0141 01C7 01C8 1E36 1E3A 1E3C 2112 FF2C
+004D 1E3E 1E40 1E42 2133 FF2D
+004E 00D1 0143 0145 0147 019D 01CA 01CB 01F8 1E44 1E46 1E48 1E4A 2115 FF2E
+004F 00D2 00D3 00D4 00D5 00D6 00D8 014C 014E 0150 019F 01A0 01D1 01EA 020C 020E 022E 1ECC 1ECE FF2F
+0050 01A4 1E54 1E56 2119 FF30
+0051 211A FF31
+0052 0154 0156 0158 0210 0212 1E58 1E5A 1E5E 211B 211C 211D FF32
+0053 015A 015C 015E 0160 0218 1E60 1E62 FF33
+0054 0162 0164 0166 01AC 01AE 021A 1E6A 1E6C 1E6E 1E70 FF34
+0055 00D9 00DA 00DB 00DC 0168 016A 016C 016E 0170 0172 01AF 01D3 0214 0216 1E72 1E74 1E76 1EE4 1EE6 FF35
+0056 01B2 1E7C 1E7E FF36
+0057 0174 1E80 1E82 1E84 1E86 1E88 FF37
+0058 1E8A 1E8C FF38
+0059 00DD 0176 0178 01B3 0232 1E8E 1EF2 1EF4 1EF6 1EF8 FF39
+005A 0179 017B 017D 01B5 0224 1E90 1E92 1E94 2124 2128 FF3A
+0061 00AA 00E0 00E1 00E2 00E3 00E4 00E5 0101 0103 0105 01CE 0201 0203 0227 1E01 1E9A 1EA1 1EA3 FF41
+0062 0180 0183 0253 1E03 1E05 1E07 FF42
+0063 00E7 0107 0109 010B 010D 0188 0255 FF43
+0064 010F 0111 018C 01C6 01F3 0256 0257 1E0B 1E0D 1E0F 1E11 1E13 FF44
+0065 00E8 00E9 00EA 00EB 0113 0115 0117 0119 011B 0205 0207 0229 1E19 1E1B 1EB9 1EBB 1EBD 212F FF45
+0066 0192 1E1F FB00 FB01 FB02 FB03 FB04 FF46
+0067 011D 011F 0121 0123 01E5 01E7 01F5 0260 1E21 210A FF47
+0068 0125 0127 021F 0266 02B0 1E23 1E25 1E27 1E29 1E2B 1E96 210E FF48
+0069 00EC 00ED 00EE 00EF 0129 012B 012D 012F 0133 01D0 0209 020B 0268 1E2D 1EC9 1ECB 2139 FF49
+006A 0135 01F0 029D 02B2 FF4A
+006B 0137 0199 01E9 1E31 1E33 1E35 FF4B
+006C 013A 013C 013E 0140 0142 019A 01C9 026B 026C 026D 02E1 1E37 1E3B 1E3D 2113 FF4C
+006D 0271 1E3F 1E41 1E43 FF4D
+006E 00F1 0144 0146 0148 019E 01CC 01F9 0272 0273 1E45 1E47 1E49 1E4B 207F FF4E
+006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 014D 014F 0151 01A1 01D2 01EB 020D 020F 022F 1ECD 1ECF 2134 FF4F
+0070 01A5 1E55 1E57 FF50
+0071 02A0 FF51
+0072 0155 0157 0159 0211 0213 027C 027D 027E 02B3 1E59 1E5B 1E5F FF52
+0073 015B 015D 015F 0161 017F 0219 0282 02E2 1E61 1E63 FB06 FF53
+0074 0163 0165 0167 01AB 01AD 021B 0288 1E6B 1E6D 1E6F 1E71 1E97 FF54
+0075 00F9 00FA 00FB 00FC 0169 016B 016D 016F 0171 0173 01B0 01D4 0215 0217 1E73 1E75 1E77 1EE5 1EE7 FF55
+0076 028B 1E7D 1E7F FF56
+0077 0175 02B7 1E81 1E83 1E85 1E87 1E89 1E98 FF57
+0078 02E3 1E8B 1E8D FF58
+0079 00FD 00FF 0177 01B4 0233 02B8 1E8F 1E99 1EF3 1EF5 1EF7 1EF9 FF59
+007A 017A 017C 017E 01B6 0225 0290 0291 1E91 1E93 1E95 FF5A
+00C2 1EA4 1EA6 1EA8 1EAA
+00C4 01DE
+00C5 01FA 212B
+00C6 01E2 01FC
+00C7 1E08
+00CA 1EBE 1EC0 1EC2 1EC4
+00CF 1E2E
+00D4 1ED0 1ED2 1ED4 1ED6
+00D5 022C 1E4C 1E4E
+00D6 022A
+00D8 01FE
+00DC 01D5 01D7 01D9 01DB
+00E2 1EA5 1EA7 1EA9 1EAB
+00E4 01DF
+00E5 01FB
+00E6 01E3 01FD
+00E7 1E09
+00EA 1EBF 1EC1 1EC3 1EC5
+00EF 1E2F
+00F4 1ED1 1ED3 1ED5 1ED7
+00F5 022D 1E4D 1E4F
+00F6 022B
+00F8 01FF
+00FC 01D6 01D8 01DA 01DC
+0102 1EAE 1EB0 1EB2 1EB4
+0103 1EAF 1EB1 1EB3 1EB5
+0112 1E14 1E16
+0113 1E15 1E17
+0127 210F
+014C 1E50 1E52
+014D 1E51 1E53
+015A 1E64
+015B 1E65
+0160 1E66
+0161 1E67
+0168 1E78
+0169 1E79
+016A 1E7A
+016B 1E7B
+017F 1E9B FB05
+0190 2107
+01A0 1EDA 1EDC 1EDE 1EE0 1EE2
+01A1 1EDB 1EDD 1EDF 1EE1 1EE3
+01AF 1EE8 1EEA 1EEC 1EEE 1EF0
+01B0 1EE9 1EEB 1EED 1EEF 1EF1
+01B7 01EE
+01EA 01EC
+01EB 01ED
+0226 01E0
+0227 01E1
+0228 1E1C
+0229 1E1D
+022E 0230
+022F 0231
+0259 025A
+025C 025D
+0262 029B
+0263 02E0
+0266 02B1
+026F 0270
+0279 027A 027B 02B4
+027B 02B5
+0281 02B6
+0283 0286
+0292 01BA 01EF 0293
+0294 02A1
+0295 02E4
+0296 01BE
+02A3 02A5
+02BC 0149
+0386 1FBB
+0388 1FC9
+0389 1FCB
+038A 1FDB
+038C 1FF9
+038E 1FEB
+038F 1FFB
+0390 1FD3
+0391 0386 1F08 1F09 1FB8 1FB9 1FBA 1FBC
+0395 0388 1F18 1F19 1FC8
+0397 0389 1F28 1F29 1FCA 1FCC
+0399 038A 03AA 1F38 1F39 1FD8 1FD9 1FDA
+039F 038C 1F48 1F49 1FF8
+03A1 1FEC
+03A5 038E 03AB 03D2 1F59 1FE8 1FE9 1FEA
+03A9 038F 1F68 1F69 1FFA 1FFC 2126
+03AC 1F71 1FB4
+03AD 1F73
+03AE 1F75 1FC4
+03AF 1F77
+03B0 1FE3
+03B1 03AC 1F00 1F01 1F70 1FB0 1FB1 1FB3 1FB6
+03B2 03D0
+03B5 03AD 1F10 1F11 1F72
+03B7 03AE 1F20 1F21 1F74 1FC3 1FC6
+03B8 03D1
+03B9 03AF 03CA 1F30 1F31 1F76 1FBE 1FD0 1FD1 1FD6
+03BA 03F0
+03BC 00B5
+03BF 03CC 1F40 1F41 1F78
+03C0 03D6
+03C1 03F1 1FE4 1FE5
+03C2 03F2
+03C5 03CB 03CD 1F50 1F51 1F7A 1FE0 1FE1 1FE6
+03C6 03D5
+03C9 03CE 1F60 1F61 1F7C 1FF3 1FF6
+03CA 0390 1FD2 1FD7
+03CB 03B0 1FE2 1FE7
+03CC 1F79
+03CD 1F7B
+03CE 1F7D 1FF4
+03D2 03D3 03D4
+0406 0407
+0410 04D0 04D2
+0413 0403 0490 0492 0494
+0415 0400 0401 04D6
+0416 0496 04C1 04DC
+0417 0498 04DE
+0418 040D 0419 04E2 04E4
+041A 040C 049A 049C 049E 04C3
+041D 04A2 04C7
+041E 04E6
+041F 04A6
+0420 048E
+0421 04AA
+0422 04AC
+0423 040E 04EE 04F0 04F2
+0425 04B2
+0427 04B6 04B8 04F4
+042B 04F8
+042D 04EC
+0430 04D1 04D3
+0433 0453 0491 0493 0495
+0435 0450 0451 04D7
+0436 0497 04C2 04DD
+0437 0499 04DF
+0438 0439 045D 04E3 04E5
+043A 045C 049B 049D 049F 04C4
+043D 04A3 04C8
+043E 04E7
+043F 04A7
+0440 048F
+0441 04AB
+0442 04AD
+0443 045E 04EF 04F1 04F3
+0445 04B3
+0447 04B7 04B9 04F5
+044B 04F9
+044D 04ED
+0456 0457
+0460 047C
+0461 047D
+0474 0476
+0475 0477
+04AE 04B0
+04AF 04B1
+04BC 04BE
+04BD 04BF
+04D8 04DA
+04D9 04DB
+04E8 04EA
+04E9 04EB
+0565 0587
+0574 FB13 FB14 FB15 FB17
+057E FB16
+05D0 2135 FB21 FB2E FB2F FB30 FB4F
+05D1 2136 FB31 FB4C
+05D2 2137 FB32
+05D3 2138 FB22 FB33
+05D4 FB23 FB34
+05D5 FB35 FB4B
+05D6 FB36
+05D8 FB38
+05D9 FB1D FB39
+05DA FB3A
+05DB FB24 FB3B FB4D
+05DC FB25 FB3C
+05DD FB26
+05DE FB3E
+05E0 FB40
+05E1 FB41
+05E2 FB20
+05E3 FB43
+05E4 FB44 FB4E
+05E6 FB46
+05E7 FB47
+05E8 FB27 FB48
+05E9 FB2A FB2B FB49
+05EA FB28 FB4A
+05F2 FB1F
+0621 FE80
+0622 FE81 FE82
+0623 FE83 FE84
+0624 FE85 FE86
+0625 FE87 FE88
+0626 FBEA FBEB FBEC FBED FBEE FBEF FBF0 FBF1 FBF2 FBF3 FBF4 FBF5 FBF6 FBF7 FBF8 FBF9 FBFA FBFB FC00 FC01 FC02 FC03 FC04 FC64 FC65 FC66 FC67 FC68 FC69 FC97 FC98 FC99 FC9A FC9B FCDF FCE0 FE89 FE8A FE8B FE8C
+0627 0622 0623 0625 0672 0673 0675 FD3C FD3D FDF2 FDF3 FE8D FE8E
+0628 FC05 FC06 FC07 FC08 FC09 FC0A FC6A FC6B FC6C FC6D FC6E FC6F FC9C FC9D FC9E FC9F FCA0 FCE1 FCE2 FD9E FDC2 FE8F FE90 FE91 FE92
+0629 FE93 FE94
+062A 067C 067D FC0B FC0C FC0D FC0E FC0F FC10 FC70 FC71 FC72 FC73 FC74 FC75 FCA1 FCA2 FCA3 FCA4 FCA5 FCE3 FCE4 FD50 FD51 FD52 FD53 FD54 FD55 FD56 FD57 FD9F FDA0 FDA1 FDA2 FDA3 FDA4 FE95 FE96 FE97 FE98
+062B FC11 FC12 FC13 FC14 FC76 FC77 FC78 FC79 FC7A FC7B FCA6 FCE5 FCE6 FE99 FE9A FE9B FE9C
+062C FC15 FC16 FCA7 FCA8 FD01 FD02 FD1D FD1E FD58 FD59 FDA5 FDA6 FDA7 FDBE FDFB FE9D FE9E FE9F FEA0
+062D 0681 0682 0685 FC17 FC18 FCA9 FCAA FCFF FD00 FD1B FD1C FD5A FD5B FDBF FEA1 FEA2 FEA3 FEA4
+062E FC19 FC1A FC1B FCAB FCAC FD03 FD04 FD1F FD20 FEA5 FEA6 FEA7 FEA8
+062F 0689 068A 068B 068F 0690 FEA9 FEAA
+0630 FC5B FEAB FEAC
+0631 0692 0693 0694 0695 0696 0697 0699 FC5C FDF6 FEAD FEAE
+0632 FEAF FEB0
+0633 069A 069B 069C FC1C FC1D FC1E FC1F FCAD FCAE FCAF FCB0 FCE7 FCE8 FCFB FCFC FD0E FD17 FD18 FD2A FD31 FD34 FD35 FD36 FD5C FD5D FD5E FD5F FD60 FD61 FD62 FD63 FDA8 FDC6 FEB1 FEB2 FEB3 FEB4
+0634 06FA FCE9 FCEA FCFD FCFE FD09 FD0A FD0B FD0C FD0D FD19 FD1A FD25 FD26 FD27 FD28 FD29 FD2D FD2E FD2F FD30 FD32 FD37 FD38 FD39 FD67 FD68 FD69 FD6A FD6B FD6C FD6D FDAA FEB5 FEB6 FEB7 FEB8
+0635 069D 069E FC20 FC21 FCB1 FCB2 FCB3 FD05 FD06 FD0F FD21 FD22 FD2B FD64 FD65 FD66 FDA9 FDC5 FDF0 FDF5 FDF9 FDFA FEB9 FEBA FEBB FEBC
+0636 06FB FC22 FC23 FC24 FC25 FCB4 FCB5 FCB6 FCB7 FD07 FD08 FD10 FD23 FD24 FD2C FD6E FD6F FD70 FDAB FEBD FEBE FEBF FEC0
+0637 069F FC26 FC27 FCB8 FCF5 FCF6 FD11 FD12 FD33 FD3A FD71 FD72 FD73 FD74 FEC1 FEC2 FEC3 FEC4
+0638 FC28 FCB9 FD3B FEC5 FEC6 FEC7 FEC8
+0639 06A0 FC29 FC2A FCBA FCBB FCF7 FCF8 FD13 FD14 FD75 FD76 FD77 FD78 FDB6 FDC4 FDF7 FEC9 FECA FECB FECC
+063A 06FC FC2B FC2C FCBC FCBD FCF9 FCFA FD15 FD16 FD79 FD7A FD7B FECD FECE FECF FED0
+0640 FCF2 FCF3 FCF4 FE71 FE77 FE79 FE7B FE7D FE7F
+0641 06A2 06A3 06A5 FC2D FC2E FC2F FC30 FC31 FC32 FC7C FC7D FCBE FCBF FCC0 FCC1 FD7C FD7D FDC1 FED1 FED2 FED3 FED4
+0642 06A7 06A8 FC33 FC34 FC35 FC36 FC7E FC7F FCC2 FCC3 FD7E FD7F FDB2 FDB4 FDF1 FED5 FED6 FED7 FED8
+0643 06AB 06AC 06AE FC37 FC38 FC39 FC3A FC3B FC3C FC3D FC3E FC80 FC81 FC82 FC83 FC84 FCC4 FCC5 FCC6 FCC7 FCC8 FCEB FCEC FDB7 FDBB FDC3 FED9 FEDA FEDB FEDC
+0644 06B5 06B6 06B7 06B8 FC3F FC40 FC41 FC42 FC43 FC44 FC85 FC86 FC87 FCC9 FCCA FCCB FCCC FCCD FCED FD80 FD81 FD82 FD83 FD84 FD85 FD86 FD87 FD88 FDAC FDAD FDB5 FDBA FDBC FEDD FEDE FEDF FEE0 FEF5 FEF6 FEF7 FEF8 FEF9 FEFA FEFB FEFC
+0645 FC45 FC46 FC47 FC48 FC49 FC4A FC88 FC89 FCCE FCCF FCD0 FCD1 FD89 FD8A FD8B FD8C FD8D FD8E FD8F FD92 FDB1 FDB9 FDC0 FDF4 FEE1 FEE2 FEE3 FEE4
+0646 06B9 06BC 06BD FC4B FC4C FC4D FC4E FC4F FC50 FC8A FC8B FC8C FC8D FC8E FC8F FCD2 FCD3 FCD4 FCD5 FCD6 FCEE FCEF FD95 FD96 FD97 FD98 FD99 FD9A FD9B FDB3 FDB8 FDBD FDC7 FEE5 FEE6 FEE7 FEE8
+0647 FC51 FC52 FC53 FC54 FCD7 FCD8 FCD9 FD93 FD94 FEE9 FEEA FEEB FEEC
+0648 0624 0676 06C4 06CA 06CF FDF8 FEED FEEE
+0649 FBE8 FBE9 FC5D FC90 FEEF FEF0
+064A 0626 0678 06CD 06CE 06D1 FC55 FC56 FC57 FC58 FC59 FC5A FC91 FC92 FC93 FC94 FC95 FC96 FCDA FCDB FCDC FCDD FCDE FCF0 FCF1 FD9C FD9D FDAE FDAF FDB0 FEF1 FEF2 FEF3 FEF4
+0671 FB50 FB51
+0677 FBDD
+0679 FB66 FB67 FB68 FB69
+067A FB5E FB5F FB60 FB61
+067B FB52 FB53 FB54 FB55
+067E FB56 FB57 FB58 FB59
+067F FB62 FB63 FB64 FB65
+0680 FB5A FB5B FB5C FB5D
+0683 FB76 FB77 FB78 FB79
+0684 FB72 FB73 FB74 FB75
+0686 06BF FB7A FB7B FB7C FB7D
+0687 FB7E FB7F FB80 FB81
+0688 FB88 FB89
+068C FB84 FB85
+068D FB82 FB83
+068E FB86 FB87
+0691 FB8C FB8D
+0698 FB8A FB8B
+06A4 FB6A FB6B FB6C FB6D
+06A6 FB6E FB6F FB70 FB71
+06A9 FB8E FB8F FB90 FB91
+06AD FBD3 FBD4 FBD5 FBD6
+06AF 06B0 06B2 06B4 FB92 FB93 FB94 FB95
+06B1 FB9A FB9B FB9C FB9D
+06B3 FB96 FB97 FB98 FB99
+06BA FB9E FB9F
+06BB FBA0 FBA1 FBA2 FBA3
+06BE FBAA FBAB FBAC FBAD
+06C0 FBA4 FBA5
+06C1 06C2 FBA6 FBA7 FBA8 FBA9
+06C5 FBE0 FBE1
+06C6 FBD9 FBDA
+06C7 0677 FBD7 FBD8
+06C8 FBDB FBDC
+06C9 FBE2 FBE3
+06CB FBDE FBDF
+06CC FBFC FBFD FBFE FBFF
+06D0 FBE4 FBE5 FBE6 FBE7
+06D2 06D3 FBAE FBAF
+06D3 FBB0 FBB1
+06D5 06C0
+0915 0958
+0916 0959
+0917 095A
+091C 095B
+0921 095C
+0922 095D
+0928 0929
+092B 095E
+092F 095F
+0930 0931
+0933 0934
+09A1 09DC
+09A2 09DD
+09AF 09DF
+09B0 09F0 09F1
+0A16 0A59
+0A17 0A5A
+0A1C 0A5B
+0A2B 0A5E
+0A32 0A33
+0A38 0A36
+0B21 0B5C
+0B22 0B5D
+0B92 0B94
+0EAB 0EDC 0EDD
+0F40 0F69
+0F42 0F43
+0F4C 0F4D
+0F51 0F52
+0F56 0F57
+0F5B 0F5C
+1025 1026
+1100 3131
+1101 3132
+1102 3134
+1103 3137
+1104 3138
+1105 3139
+1106 3141
+1107 3142
+1108 3143
+1109 3145
+110A 3146
+110B 3147
+110C 3148
+110D 3149
+110E 314A
+110F 314B
+1110 314C
+1111 314D
+1112 314E
+1114 3165
+1115 3166
+111A 3140
+111C 316E
+111D 3171
+111E 3172
+1120 3173
+1121 3144
+1122 3174
+1123 3175
+1127 3176
+1129 3177
+112B 3178
+112C 3179
+112D 317A
+112E 317B
+112F 317C
+1132 317D
+1136 317E
+1140 317F
+1147 3180
+114C 3181
+1157 3184
+1158 3185
+1159 3186
+1160 3164
+1161 314F
+1162 3150
+1163 3151
+1164 3152
+1165 3153
+1166 3154
+1167 3155
+1168 3156
+1169 3157
+116A 3158
+116B 3159
+116C 315A
+116D 315B
+116E 315C
+116F 315D
+1170 315E
+1171 315F
+1172 3160
+1173 3161
+1174 3162
+1175 3163
+1184 3187
+1185 3188
+1188 3189
+1191 318A
+1192 318B
+1194 318C
+119E 318D
+11A1 318E
+11AA 3133
+11AC 3135
+11AD 3136
+11B0 313A
+11B1 313B
+11B2 313C
+11B3 313D
+11B4 313E
+11B5 313F
+11C7 3167
+11C8 3168
+11CC 3169
+11CE 316A
+11D3 316B
+11D7 316C
+11D9 316D
+11DD 316F
+11DF 3170
+11F1 3182
+11F2 3183
+1E36 1E38
+1E37 1E39
+1E5A 1E5C
+1E5B 1E5D
+1E62 1E68
+1E63 1E69
+1EA0 1EAC 1EB6
+1EA1 1EAD 1EB7
+1EB8 1EC6
+1EB9 1EC7
+1ECC 1ED8
+1ECD 1ED9
+1F00 1F02 1F04 1F06 1F80
+1F01 1F03 1F05 1F07 1F81
+1F02 1F82
+1F03 1F83
+1F04 1F84
+1F05 1F85
+1F06 1F86
+1F07 1F87
+1F08 1F0A 1F0C 1F0E 1F88
+1F09 1F0B 1F0D 1F0F 1F89
+1F0A 1F8A
+1F0B 1F8B
+1F0C 1F8C
+1F0D 1F8D
+1F0E 1F8E
+1F0F 1F8F
+1F10 1F12 1F14
+1F11 1F13 1F15
+1F18 1F1A 1F1C
+1F19 1F1B 1F1D
+1F20 1F22 1F24 1F26 1F90
+1F21 1F23 1F25 1F27 1F91
+1F22 1F92
+1F23 1F93
+1F24 1F94
+1F25 1F95
+1F26 1F96
+1F27 1F97
+1F28 1F2A 1F2C 1F2E 1F98
+1F29 1F2B 1F2D 1F2F 1F99
+1F2A 1F9A
+1F2B 1F9B
+1F2C 1F9C
+1F2D 1F9D
+1F2E 1F9E
+1F2F 1F9F
+1F30 1F32 1F34 1F36
+1F31 1F33 1F35 1F37
+1F38 1F3A 1F3C 1F3E
+1F39 1F3B 1F3D 1F3F
+1F40 1F42 1F44
+1F41 1F43 1F45
+1F48 1F4A 1F4C
+1F49 1F4B 1F4D
+1F50 1F52 1F54 1F56
+1F51 1F53 1F55 1F57
+1F59 1F5B 1F5D 1F5F
+1F60 1F62 1F64 1F66 1FA0
+1F61 1F63 1F65 1F67 1FA1
+1F62 1FA2
+1F63 1FA3
+1F64 1FA4
+1F65 1FA5
+1F66 1FA6
+1F67 1FA7
+1F68 1F6A 1F6C 1F6E 1FA8
+1F69 1F6B 1F6D 1F6F 1FA9
+1F6A 1FAA
+1F6B 1FAB
+1F6C 1FAC
+1F6D 1FAD
+1F6E 1FAE
+1F6F 1FAF
+1F70 1FB2
+1F74 1FC2
+1F7C 1FF2
+1FB6 1FB7
+1FC6 1FC7
+1FF6 1FF7
+3046 3094
+304B 304C
+304D 304E
+304F 3050
+3051 3052
+3053 3054
+3055 3056
+3057 3058
+3059 305A
+305B 305C
+305D 305E
+305F 3060
+3061 3062
+3064 3065
+3066 3067
+3068 3069
+306F 3070 3071
+3072 3073 3074
+3075 3076 3077
+3078 3079 307A
+307B 307C 307D
+309D 309E
+30A1 FF67
+30A2 FF71
+30A3 FF68
+30A4 FF72
+30A5 FF69
+30A6 30F4 FF73
+30A7 FF6A
+30A8 FF74
+30A9 FF6B
+30AA FF75
+30AB 30AC FF76
+30AD 30AE FF77
+30AF 30B0 FF78
+30B1 30B2 FF79
+30B3 30B4 FF7A
+30B5 30B6 FF7B
+30B7 30B8 FF7C
+30B9 30BA FF7D
+30BB 30BC FF7E
+30BD 30BE FF7F
+30BF 30C0 FF80
+30C1 30C2 FF81
+30C3 FF6F
+30C4 30C5 FF82
+30C6 30C7 FF83
+30C8 30C9 FF84
+30CA FF85
+30CB FF86
+30CC FF87
+30CD FF88
+30CE FF89
+30CF 30D0 30D1 FF8A
+30D2 30D3 30D4 FF8B
+30D5 30D6 30D7 FF8C
+30D8 30D9 30DA FF8D
+30DB 30DC 30DD FF8E
+30DE FF8F
+30DF FF90
+30E0 FF91
+30E1 FF92
+30E2 FF93
+30E3 FF6C
+30E4 FF94
+30E5 FF6D
+30E6 FF95
+30E7 FF6E
+30E8 FF96
+30E9 FF97
+30EA FF98
+30EB FF99
+30EC FF9A
+30ED FF9B
+30EF 30F7 FF9C
+30F0 30F8
+30F1 30F9
+30F2 30FA FF66
+30F3 FF9D
+30FC FF70
+30FD 30FE
+3131 FFA1
+3132 FFA2
+3133 FFA3
+3134 FFA4
+3135 FFA5
+3136 FFA6
+3137 FFA7
+3138 FFA8
+3139 FFA9
+313A FFAA
+313B FFAB
+313C FFAC
+313D FFAD
+313E FFAE
+313F FFAF
+3140 FFB0
+3141 FFB1
+3142 FFB2
+3143 FFB3
+3144 FFB4
+3145 FFB5
+3146 FFB6
+3147 FFB7
+3148 FFB8
+3149 FFB9
+314A FFBA
+314B FFBB
+314C FFBC
+314D FFBD
+314E FFBE
+314F FFC2
+3150 FFC3
+3151 FFC4
+3152 FFC5
+3153 FFC6
+3154 FFC7
+3155 FFCA
+3156 FFCB
+3157 FFCC
+3158 FFCD
+3159 FFCE
+315A FFCF
+315B FFD2
+315C FFD3
+315D FFD4
+315E FFD5
+315F FFD6
+3160 FFD7
+3161 FFDA
+3162 FFDB
+3163 FFDC
+3164 FFA0
+FB49 FB2C FB2D
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FB00 FB4F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0600 06FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FB50 FDFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FE70 FEFE
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0530 058F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2190 21FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 007F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0980 09FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2580 259F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3100 312F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+31A0 31BF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2500 257F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+2800 28FF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3300 33FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FE30 FE4F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
F900 FAFF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+2E80 2EFF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3000 303F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
4E00 9FFF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+3400 4DB5
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+13A0 13FF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0300 036F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FE20 FE2F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
20D0 20FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2400 243F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
20A0 20CF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0400 04FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0900 097F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2700 27BF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2460 24FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3200 32FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
1200 137F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2000 206F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
25A0 25FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
10A0 10FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0370 03FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
1F00 1FFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0A80 0AFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0A00 0A7F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FF00 FFEF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3130 318F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
1100 11FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
AC00 D7A3
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0590 05FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
DB80 DBFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
D800 DB7F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3040 309F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0250 02AF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+2FF0 2FFF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3190 319F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+2F00 2FDF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0C80 0CFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
30A0 30FF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+1780 17FF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0E80 0EFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0080 00FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0100 017F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0180 024F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
1E00 1EFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2100 214F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
DC00 DFFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0D00 0D7F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2200 22FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2600 26FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2300 23FF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+1800 18AF
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+1000 109F
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2150 218F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+1680 169F
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2440 245F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0B00 0B7F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
E000 F8FF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+16A0 16FF
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+0D80 0DFF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FE50 FE6F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
02B0 02FF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
FFF0 FFFD
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2070 209F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+0700 074F
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0B80 0BFF
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0C00 0C7F
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+0780 07BF
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0E00 0E7F
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0F00 0FFF
END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+1400 167F
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+A490 A4CF
+END
--- /dev/null
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
+return <<'END';
+A000 A48F
+END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 007f
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
0041 005a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a
0061 007a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0660 0669
066b 066c
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
000a
000d
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
002c
002e
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
00b2 00b3
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
002f
ff0f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0023 0025
002b
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a
0061 007a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0021 0022
0026 002a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
05be
05c0
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0009
000b
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
000c
0020
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 001f
007f 009f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 001f
007f 009f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 001f
007f 009f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
e000 f8ff
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2460 2473
24b6 24ea
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00a8
00af
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fb51
fb53
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2102
210a 2113
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fb55
fb59
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fb54
fb58
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fb50
fb52
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
ff61 ffbe
ffc2 ffc7
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00a0
0f0c
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fe50 fe52
fe54 fe66
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3300 3357
3371 3376
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2080 208e
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00aa
00b2 00b3
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
fe30 fe44
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
3000
ff01 ff5e
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00c0 00c5
00c7 00cf
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00a0
00a8
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
0660 0669
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0021 007e
00a0 021f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a
0061 007a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0061 007a
00aa
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
02b0 02b8
02bb 02c1
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
01bb
01c0 01c3
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0061 007a
00aa
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
01c5
01c8
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a
00c0 00d6
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0300 034e
0360 0362
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0903
093e 0940
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0028 0029
003c
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0300 034e
0360 0362
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
00b2 00b3
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
0660 0669
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00b2 00b3
00b9
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0021 0023
0025 002a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
002d
00ad
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0029
005d
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0021 0023
0025 0027
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0020 007e
00a0 021f
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0028
005b
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0021 0023
0025 002a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0024
002b
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0024
00a2 00a5
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
002b
003c 003e
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
00a6 00a7
00a9
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0009 000a
000c 000d
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a
00c0 00d6
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
0041 005a
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039
0041 0046
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0020
00a0
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2028
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
2029
END
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0020
00a0
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
1100 G
1101 GG
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0000 001f <control>
0020 SPACE
--- /dev/null
+<html>
+
+<head>
+<meta name="GENERATOR" content="Microsoft FrontPage 3.0">
+<title>Unicode 3.0 NamesList File Structure</title>
+</head>
+
+<body>
+
+<h3>Unicode NamesList File Format</h3>
+
+<p>Last updated: 1999-07-06</p>
+
+<h3>1.0 Introduction</h3>
+
+<p>The Unicode name list file NamesList.txt (also NamesList.lst) is a plain text file used
+to drive the layout of the character code charts in the Unicode Standard. The information
+in this file is a combination of several fields from the UnicodeData.txt and Blocks.txt files,
+together with additional annotations for many characters. This document describes the
+syntax rules for the file format, but also gives brief information on how each construct
+is rendered when laid out for the book. Some of the syntax elements were used in
+preparation of the drafts of the book and may not be present in the final, released form
+of the NamesList.txt file.</p>
+
+<p>The same input file can be used to do the draft preparation for ISO/IEC 10646 (referred
+below as ISO-style). This necessitates the presence of some information in the name list
+file that is not needed (and in fact removed during parsing) for the Unicode book.</p>
+
+<p>With access to the layout program (unibook.exe) it is a simple matter of creating
+name lists for the purpose of formatting working drafts containing proposed characters.</p>
+
+<h3>1.1 NamesList File Overview</h3>
+
+<p>The *.lst files are plain text files which in their most simple form look like this</p>
+
+<p>@@<tab>0020<tab>BASIC LATIN<tab>007F<br>
+; this is a file comment (ignored)<br>
+0020<tab>SPACE<br>
+0021<tab>EXCLAMATION MARK<br>
+0022<tab>QUOTATION MARK<br>
+. . . <br>
+007F<tab>DELETE</p>
+
+<p>The semicolon (as first character), @ and <tab> characters are used by the file
+syntax and must be provided as shown. Hexadecimal digits must be in UPPER CASE). A double
+@@ introduces a block header, with the title, and start and ending code of the block
+provided as shown.</p>
+
+<p>For an ISO-style, minimal name list, only the NAME_LINE and BLOCKHEADER and their
+constituent syntax elements are needed.</p>
+
+<p>The full syntax with all the options is provided in the following sections.</p>
+
+<h3>1.2 NamesList File Structure</h3>
+
+<p>This section gives defines the overall file structure</p>
+
+<pre><strong>NAMELIST: TITLE_PAGE* BLOCK*
+</strong>
+<strong>TITLE_PAGE: TITLE
+ | TITLE_PAGE SUBTITLE
+ | TITLE_PAGE SUBHEADER
+ | TITLE_PAGE IGNORED_LINE
+ | TITLE_PAGE EMPTY_LINE
+ | TITLE_PAGE COMMENTLINE
+ | TITLE_PAGE NOTICE
+ | TITLE_PAGE PAGEBREAK
+</strong>
+<strong>BLOCK: BLOCKHEADER
+ | BLOCK CHAR_ENTRY
+ | BLOCK SUBHEADER
+ | BLOCK NOTICE
+ | BLOCK EMPTY_LINE
+ | BLOCK IGNORED_LINE
+ | BLOCK PAGEBREAK
+
+CHAR_ENTRY: NAME_LINE | RESERVED_LINE
+ | CHAR_ENTRY ALIAS_LINE
+ | CHAR_ENTRY COMMENT_LINE
+ | CHAR_ENTRY CROSS_REF
+ | CHAR_ENTRY DECOMPOSITION
+ | CHAR_ENTRY COMPAT_MAPPING
+ | CHAR_ENTRY IGNORED_LINE
+ | CHAR_ENTRY EMPTY_LINE
+ | CHAR_ENTRY NOTICE
+</strong></pre>
+
+<p>In other words:<br>
+<br>
+Neither TITLE nor SUBTITLE may occur after the first BLOCKHEADER. </p>
+
+<p>Only TITLE, SUBTITLE, SUBHEADER, PAGEBREAK, COMMENT_LINE, and IGNORED_LINE may
+occur before the first BLOCKHEADER.</p>
+
+<p>Directly following either a NAME_LINE or a RESERVED_LINE an uninterrupted sequence of
+the following lines may occur (in any order and repeated as often as needed): ALIAS_LINE,
+CROSS_REF, DECOMPOSITION, COMPAT_MAPPING, NOTICE, EMPTY_LINE and IGNORED_LINE.</p>
+
+<p>Except for EMPTY_LINE, NOTICE and IGNORED_LINE, none of these lines may occur in any other
+place. </p>
+
+<p>Note: A NOTICE displays differently depending on whether it follows a header or title
+or is part of a CHAR_ENTRY.</p>
+
+<h3>1.3 NamesList File Elements</h3>
+
+<p>This section provides the details of the syntax for the individual elements.</p>
+
+<pre><small><strong>ELEMENT SYNTAX</strong> // How rendered</small></pre>
+
+<pre><small><strong>NAME_LINE: CHAR <tab> LINE
+</strong> // the CHAR and the corresponding image are echoed,
+ // followed by the name as given in LINE
+
+<strong> CHAR TAB NAME COMMENT LF
+</strong> // Names may have a comment, which is stripped off
+ // unless the file is parsed for an ISO style list
+
+<strong>RESERVED_LINE: CHAR TAB <reserved>
+</strong> // the CHAR is echoed followed by an icon for the
+ // reserved character and a fixed string e.g. <reserved>
+
+<strong>COMMMENT_LINE: <tab> "*" SP EXPAND_LINE
+</strong> // * is replaced by BULLET, output line as comment
+ <strong><tab> EXPAND_LINE</strong>
+ // output line as comment
+
+<strong>ALIAS_LINE: <tab> "=" SP LINE
+</strong> // replace = by itself, output line as alias
+
+<strong>CROSS_REF: <tab> "X" SP EXPAND_LINE
+</strong> // X is replaced by a right arrow
+<strong> <tab> "X" SP "(" STRING SP "-" SP CHAR ")"
+</strong> // X is replaced by a right arrow
+ // the "(", "-", ")" are removed, the
+ // order of CHAR and STRING is reversed
+ // i.e. both inputs result in the same output
+
+<strong>IGNORED_LINE: <tab> ";" EXPAND_LINE
+EMPTY_LINE: LF
+</strong> // empty lines and file comments are ignored
+
+<strong>DECOMPOSITION: <tab> ":" EXPAND_LINE
+</strong> // replace ':' by EQUIV, expand line into
+ // decomposition
+
+<strong>COMPAT_MAPPING: <tab> "#" SP EXPAND_LINE
+</strong> // replace '#' by APPROX, output line as mapping
+
+<strong>NOTICE: "@+" <tab> LINE
+</strong> // skip '@+', output text as notice
+<strong> "@+" TAB * SP LINE
+</strong> // skip '@', output text as notice
+ // "*" expands to a bullet character
+ // Notices following a character code apply to the
+ // character and are indented. Notices not following
+ // a character code apply to the page/block/column
+ // and are italicized, but not indented
+
+<strong>SUBTITLE: "@@@+" <tab> LINE
+</strong> // skip "@@@+", output text as subtitle
+
+<strong>SUBHEADER: "@" <tab> LINE
+</strong> // skip '@', output line as text as column header
+
+<strong>BLOCKHEADER: "@@" <tab> BLOCKSTART <tab> BLOCKNAME <tab> BLOCKEND
+</strong> // skip "@@", cause a page break and optional
+ // blank page, then output one or more charts
+ // followed by the list of character names.
+ // use BLOCKSTART and BLOCKEND to define the
+ // what characters belong to a block
+ // use blockname in page and table headers
+ <strong> "@@" <tab> BLOCKSTART <tab> BLOCKNAME COMMENT <tab> BLOCKEND
+ </strong>// if a comment is present it replaces the blockname
+ // when an ISO-style namelist is laid out
+
+<strong>BLOCKSTART: CHAR</strong> // first character position in block
+<strong>BLOCKEND: CHAR</strong> // last character position in block
+<strong>PAGE_BREAK: "@@"</strong> // insert a (column) break
+
+<strong>TITLE: "@@@" <tab> LINE</strong>
+ // skip "@@@", output line as text
+ // Title is used in page headers
+
+<strong>EXPAND_LINE: {CHAR | STRING}+ LF </strong>
+ // all instances of CHAR *) are replaced by
+ // CHAR NBSP x NBSP where x is the single Unicode
+ // character corresponding to char
+ // If character is combining, it is replaced with
+ // CHAR NBSP <circ> x NBSP where <circ> is the
+ // dotted circle</small>
+</pre>
+
+<h3><strong>1.4 NamesList File Primitives</strong></h3>
+
+<p>The following are the primitives and terminals for the NamesList syntax.</p>
+
+<pre><small><strong>LINE: STRING LF
+COMMENT: "(" NAME ")"
+ "(" NAME ")" "*"
+</strong>
+<strong>NAME</strong>: <sequence of ASCII characters, except "(" or ")" >
+<strong>STRING</strong>: <sequence of Latin-1 characters>
+<strong>CHAR</strong>: <strong>X X X X</strong>
+ <strong>| X X X X X X X X X</strong></small>
+<small><strong>X: "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"A"|"B"|"C"|"D"|"E"|"F"
+<tab>:</strong> <sequence of one or more ASCII tab characters 0x09>
+<strong>SP</strong>: <ASCII 0x20>
+<strong>LF</strong>: <any sequence of ASCII 0x0A and 0x0D>
+</small></pre>
+
+<p><strong>Notes:</strong>
+
+<ul>
+ <li>Special lookahead logic prevents a mention of a 4 digit standard, such as ISO 9999 from
+ being misinterpreted as ISO CHAR.</li>
+ <li>Use of Latin-1 is supported in unibook.exe, but not portably, unless the file is encoded as
+ UTF-16LE.</li>
+ <li>The final LF in the file must be present</li>
+ <li>A CHAR inside ' or " is expanded, but only its glyph image is printed, the
+ code value is not echoed</li>
+ <li>Straight quotes in an EXPAND_LINE are replaced by curly quotes using English rules.
+ Apostrophes are supported, but nested quotes are not.</li>
+</ul>
+</body>
+</html>
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0031 1
0032 2
--------------------------------------------------------------------------
NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
-The files have been copied 1999-Sep-14 from
+The files have been copied from
ftp://ftp.unicode.org/Public/3.0-Update/
-and renamed to better fit 8.3 filename limitations.
-
-For example, the UnicodeCharacterDatabase.html referred above is
-now called Unicode.html.
-
+and most of them have been renamed to better fit 8.3 filename limitations.
+
+long name at unicode.org short name latest '#'
+------------------------ ---------- ----------
+ArabicShaping-#.txt ArabShap.txt 2
+Blocks-#.txt Blocks.txt 3
+CompositionExclusions-#.txt CompExcl.txt 1
+EastAsianWidth-#.txt EAWidth.txt 3
+Index-#.txt Index.txt 3.0.0
+Jamo-#.txt Jamo.txt 2
+LineBreak-#.txt LineBrk.txt 5
+NamesList-#.txt Names.txt 3.0.0
+NamesList-#.html NamesList.html 1
+PropList-#.txt Props.txt 3.0.0
+SpecialCasing-#.txt SpecCase.txt 2
+UnicodeData-#.txt Unicode.300 3.0.0
+UnicodeData-#.html Unicode3.html 3.0.0
+UnicodeCharacterDatabase-#.html UCD300.html 3.0.0
+
+The *.pl files are generated from these files by the 'mktables.PL' script.
+
+While the files have been renamed the links in the html files haven't.
+
+--
jhi@iki.fi
-
-
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0030 0039 0000
00b2 00b3 0002
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0041 005a 0061
00c0 00d6 00e0
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0061 007a 0041
00b5 039c
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by mktables.PL from e.g. Unicode.300.
+# Any changes made here will be lost!
return <<'END';
0061 007a 0041
00b5 039c
--- /dev/null
+<html>
+
+
+
+<head>
+
+<meta NAME="GENERATOR" CONTENT="Microsoft FrontPage 4.0">
+
+<meta HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=UTF-8">
+
+<link REL="stylesheet" HREF="http://www.unicode.org/unicode.css" TYPE="text/css">
+
+<title>UnicodeData File Format</title>
+
+</head>
+
+
+
+<body>
+
+
+
+<h1>UnicodeData File Format<br>
+Version 3.0.0</h1>
+
+
+
+<table BORDER="1" CELLSPACING="2" CELLPADDING="0" HEIGHT="87" WIDTH="100%">
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">Revision</td>
+
+ <td VALIGN="TOP">3.0.0</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">Authors</td>
+
+ <td VALIGN="TOP">Mark Davis and Ken Whistler</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">Date</td>
+
+ <td VALIGN="TOP">1999-09-12</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">This Version</td>
+
+ <td VALIGN="TOP"><a href="ftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html">ftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html</a></td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">Previous Version</td>
+
+ <td VALIGN="TOP">n/a</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP" width="144">Latest Version</td>
+
+ <td VALIGN="TOP"><a href="ftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html">ftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html</a></td>
+
+ </tr>
+
+</table>
+
+
+
+<p align="center">Copyright © 1995-1999 Unicode, Inc. All Rights reserved.<br>
+
+<i>For more information, including Disclamer and Limitations, see <a HREF="UnicodeCharacterDatabase-3.0.0.html">UnicodeCharacterDatabase-3.0.0.html</a> </i></p>
+
+
+
+<p>This document describes the format of the UnicodeData.txt file, which is one of the
+
+files in the Unicode Character Database. The document is divided into the following
+
+sections:
+
+
+
+<ul>
+
+ <li><a HREF="#Field Formats">Field Formats</a> <ul>
+
+ <li><a HREF="#General Category">General Category</a> </li>
+
+ <li><a HREF="#Bidirectional Category">Bidirectional Category</a> </li>
+
+ <li><a HREF="#Character Decomposition">Character Decomposition Mapping</a> </li>
+
+ <li><a HREF="#Canonical Combining Classes">Canonical Combining Classes</a> </li>
+
+ <li><a HREF="#Decompositions and Normalization">Decompositions and Normalization</a> </li>
+
+ <li><a HREF="#Case Mappings">Case Mappings</a> </li>
+
+ </ul>
+
+ </li>
+
+ <li><a HREF="#Property Invariants">Property Invariants</a> </li>
+
+ <li><a HREF="#Modification History">Modification History</a> </li>
+
+</ul>
+
+
+
+<p><b>Warning: </b>the information in this file does not completely describe the use and
+
+interpretation of Unicode character properties and behavior. It must be used in
+
+conjunction with the data in the other files in the Unicode Character Database, and relies
+
+on the notation and definitions supplied in <i><a href="http://www.unicode.org/unicode/standard/versions/Unicode3.0.html"> The Unicode
+Standard</a></i>. All chapter references
+
+are to Version 3.0 of the standard.</p>
+
+
+
+<h2><a NAME="Field Formats"></a>Field Formats</h2>
+
+
+
+<p>The file consists of lines containing fields terminated by semicolons. Each line
+
+represents the data for one encoded character in the Unicode Standard. Every encoded
+
+character has a data entry, with the exception of certain special ranges, as detailed
+
+below.
+
+
+
+<ul>
+
+ <li>There are six special ranges of characters that are represented only by their start and
+
+ end characters, since the properties in the file are uniform, except for code values
+
+ (which are all sequential and assigned). </li>
+
+ <li>The names of CJK ideograph characters and the names and decompositions of Hangul
+
+ syllable characters are algorithmically derivable. (See the Unicode Standard and <a
+
+ HREF="http://www.unicode.org/unicode/reports/tr15/">Unicode Technical Report #15</a> for
+
+ more information). </li>
+
+ <li>Surrogate code values and private use characters have no names. </li>
+
+ <li>The Private Use character outside of the BMP (U+F0000..U+FFFFD, U+100000..U+10FFFD) are
+
+ not listed. These correspond to surrogate pairs where the first surrogate is in the High
+
+ Surrogate Private Use section. </li>
+
+</ul>
+
+
+
+<p>The exact ranges represented by start and end characters are:
+
+
+
+<ul>
+
+ <li>CJK Ideographs Extension A (U+3400 - U+4DB5) </li>
+
+ <li>CJK Ideographs (U+4E00 - U+9FA5) </li>
+
+ <li>Hangul Syllables (U+AC00 - U+D7A3) </li>
+
+ <li>Non-Private Use High Surrogates (U+D800 - U+DB7F) </li>
+
+ <li>Private Use High Surrogates (U+DB80 - U+DBFF) </li>
+
+ <li>Low Surrogates (U+DC00 - U+DFFF) </li>
+
+ <li>The Private Use Area (U+E000 - U+F8FF) </li>
+
+</ul>
+
+
+
+<p>The following table describes the format and meaning of each field in a data entry in
+
+the UnicodeData file. Fields which contain normative information are so indicated.</p>
+
+
+
+<table BORDER="1" CELLSPACING="2" CELLPADDING="2">
+
+ <tr>
+
+ <th VALIGN="top" ALIGN="LEFT"><p ALIGN="LEFT">Field</th>
+
+ <th VALIGN="top" ALIGN="LEFT"><p ALIGN="LEFT">Name</th>
+
+ <th VALIGN="top" ALIGN="LEFT"><p ALIGN="LEFT">Status</th>
+
+ <th VALIGN="top" ALIGN="LEFT"><p ALIGN="LEFT">Explanation</th>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">0</th>
+
+ <td VALIGN="top">Code value</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">Code value in 4-digit hexadecimal format.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">1</th>
+
+ <td VALIGN="top">Character name</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">These names match exactly the names published in Chapter 14 of the
+
+ Unicode Standard, Version 3.0.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">2</th>
+
+ <td VALIGN="top"><a HREF="#General Category">General Category</a> </td>
+
+ <td VALIGN="top">normative / informative<br>
+
+ (see below)</td>
+
+ <td VALIGN="top">This is a useful breakdown into various "character types" which
+
+ can be used as a default categorization in implementations. See below for a brief
+
+ explanation.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">3</th>
+
+ <td VALIGN="top"><a HREF="#Canonical Combining Classes">Canonical Combining Classes</a> </td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">The classes used for the Canonical Ordering Algorithm in the Unicode
+
+ Standard. These classes are also printed in Chapter 4 of the Unicode Standard.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">4</th>
+
+ <td VALIGN="top"><a HREF="#Bidirectional Category">Bidirectional Category</a> </td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">See the list below for an explanation of the abbreviations used in this
+
+ field. These are the categories required by the Bidirectional Behavior Algorithm in the
+
+ Unicode Standard. These categories are summarized in Chapter 3 of the Unicode Standard.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">5</th>
+
+ <td VALIGN="top"><a HREF="#Character Decomposition">Character Decomposition
+ Mapping</a></td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">In the Unicode Standard, not all of the mappings are full (maximal)
+
+ decompositions. Recursive application of look-up for decompositions will, in all cases,
+
+ lead to a maximal decomposition. The decomposition mappings match exactly the
+
+ decomposition mappings published with the character names in the Unicode Standard.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">6</th>
+
+ <td VALIGN="top">Decimal digit value</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">This is a numeric field. If the character has the decimal digit property,
+
+ as specified in Chapter 4 of the Unicode Standard, the value of that digit is represented
+
+ with an integer value in this field</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">7</th>
+
+ <td VALIGN="top">Digit value</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">This is a numeric field. If the character represents a digit, not
+
+ necessarily a decimal digit, the value is here. This covers digits which do not form
+
+ decimal radix forms, such as the compatibility superscript digits</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">8</th>
+
+ <td VALIGN="top">Numeric value</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">This is a numeric field. If the character has the numeric property, as
+
+ specified in Chapter 4 of the Unicode Standard, the value of that character is represented
+
+ with an integer or rational number in this field. This includes fractions as, e.g.,
+
+ "1/5" for U+2155 VULGAR FRACTION ONE FIFTH Also included are numerical values
+
+ for compatibility characters such as circled numbers.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">8</th>
+
+ <td VALIGN="top">Mirrored</td>
+
+ <td VALIGN="top">normative</td>
+
+ <td VALIGN="top">If the character has been identified as a "mirrored" character
+
+ in bidirectional text, this field has the value "Y"; otherwise "N".
+
+ The list of mirrored characters is also printed in Chapter 4 of the Unicode Standard.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">10</th>
+
+ <td VALIGN="top">Unicode 1.0 Name</td>
+
+ <td VALIGN="top">informative</td>
+
+ <td VALIGN="top">This is the old name as published in Unicode 1.0. This name is only
+
+ provided when it is significantly different from the Unicode 3.0 name for the character.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">11</th>
+
+ <td VALIGN="top">10646 comment field</td>
+
+ <td VALIGN="top">informative</td>
+
+ <td VALIGN="top">This is the ISO 10646 comment field. It is in parantheses in the 10646
+
+ names list.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">12</th>
+
+ <td VALIGN="top"><a HREF="#Case Mappings">Uppercase Mapping</a></td>
+
+ <td VALIGN="top">informative</td>
+
+ <td VALIGN="top">Upper case equivalent mapping. If a character is part of an alphabet with
+
+ case distinctions, and has an upper case equivalent, then the upper case equivalent is in
+
+ this field. See the explanation below on case distinctions. These mappings are always
+
+ one-to-one, not one-to-many or many-to-one. This field is informative.</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">13</th>
+
+ <td VALIGN="top"><a HREF="#Case Mappings">Lowercase Mapping</a></td>
+
+ <td VALIGN="top">informative</td>
+
+ <td VALIGN="top">Similar to Uppercase mapping</td>
+
+ </tr>
+
+ <tr>
+
+ <th VALIGN="top">14</th>
+
+ <td VALIGN="top"><a HREF="#Case Mappings">Titlecase Mapping</a></td>
+
+ <td VALIGN="top">informative</td>
+
+ <td VALIGN="top">Similar to Uppercase mapping</td>
+
+ </tr>
+
+</table>
+
+
+
+<h3><a NAME="General Category"></a>General Category</h3>
+
+
+
+<p>The values in this field are abbreviations for the following. Some of the values are
+
+normative, and some are informative. For more information, see the Unicode Standard.</p>
+
+
+
+<p><b>Note:</b> the standard does not assign information to control characters (except for
+
+certain cases in the Bidirectional Algorithm). Implementations will generally also assign
+
+categories to certain control characters, notably CR and LF, according to platform
+
+conventions.</p>
+
+
+
+<h4>Normative Categories</h4>
+
+
+
+<table BORDER="0" CELLSPACING="2" CELLPADDING="0">
+
+ <tr>
+
+ <th><p ALIGN="LEFT">Abbr.</th>
+
+ <th><p ALIGN="LEFT">Description</th>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Lu</td>
+
+ <td>Letter, Uppercase</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Ll</td>
+
+ <td>Letter, Lowercase</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Lt</td>
+
+ <td>Letter, Titlecase</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Mn</td>
+
+ <td>Mark, Non-Spacing</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Mc</td>
+
+ <td>Mark, Spacing Combining</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Me</td>
+
+ <td>Mark, Enclosing</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Nd</td>
+
+ <td>Number, Decimal Digit</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Nl</td>
+
+ <td>Number, Letter</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">No</td>
+
+ <td>Number, Other</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Zs</td>
+
+ <td>Separator, Space</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Zl</td>
+
+ <td>Separator, Line</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Zp</td>
+
+ <td>Separator, Paragraph</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Cc</td>
+
+ <td>Other, Control</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Cf</td>
+
+ <td>Other, Format</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Cs</td>
+
+ <td>Other, Surrogate</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Co</td>
+
+ <td>Other, Private Use</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Cn</td>
+
+ <td>Other, Not Assigned (no characters in the file have this property)</td>
+
+ </tr>
+
+</table>
+
+
+
+<h4>Informative Categories</h4>
+
+
+
+<table BORDER="0" CELLSPACING="2" CELLPADDING="0">
+
+ <tr>
+
+ <th><p ALIGN="LEFT">Abbr.</th>
+
+ <th><p ALIGN="LEFT">Description</th>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Lm</td>
+
+ <td>Letter, Modifier</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Lo</td>
+
+ <td>Letter, Other</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Pc</td>
+
+ <td>Punctuation, Connector</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Pd</td>
+
+ <td>Punctuation, Dash</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Ps</td>
+
+ <td>Punctuation, Open</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Pe</td>
+
+ <td>Punctuation, Close</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Pi</td>
+
+ <td>Punctuation, Initial quote (may behave like Ps or Pe depending on usage)</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Pf</td>
+
+ <td>Punctuation, Final quote (may behave like Ps or Pe depending on usage)</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Po</td>
+
+ <td>Punctuation, Other</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Sm</td>
+
+ <td>Symbol, Math</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Sc</td>
+
+ <td>Symbol, Currency</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">Sk</td>
+
+ <td>Symbol, Modifier</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER">So</td>
+
+ <td>Symbol, Other</td>
+
+ </tr>
+
+</table>
+
+
+
+<h3><a NAME="Bidirectional Category"></a>Bidirectional Category</h3>
+
+
+
+<p>Please refer to Chapter 3 for an explanation of the algorithm for Bidirectional
+
+Behavior and an explanation of the significance of these categories. An up-to-date version
+
+can be found on <a HREF="http://www.unicode.org/unicode/reports/tr9/">Unicode Technical
+
+Report #9: The Bidirectional Algorithm</a>. These values are normative.</p>
+
+
+
+<table BORDER="0" CELLPADDING="2">
+
+ <tr>
+
+ <th VALIGN="TOP" ALIGN="LEFT"><p ALIGN="LEFT">Type</th>
+
+ <th VALIGN="TOP" ALIGN="LEFT"><p ALIGN="LEFT">Description</th>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>L</b></td>
+
+ <td VALIGN="TOP">Left-to-Right</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>LRE</b></td>
+
+ <td VALIGN="TOP">Left-to-Right Embedding</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>LRO</b></td>
+
+ <td VALIGN="TOP">Left-to-Right Override</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>R</b></td>
+
+ <td VALIGN="TOP">Right-to-Left</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>AL</b></td>
+
+ <td VALIGN="TOP">Right-to-Left Arabic</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>RLE</b></td>
+
+ <td VALIGN="TOP">Right-to-Left Embedding</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>RLO</b></td>
+
+ <td VALIGN="TOP">Right-to-Left Override</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>PDF</b></td>
+
+ <td VALIGN="TOP">Pop Directional Format</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>EN</b></td>
+
+ <td VALIGN="TOP">European Number</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>ES</b></td>
+
+ <td VALIGN="TOP">European Number Separator</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>ET</b></td>
+
+ <td VALIGN="TOP">European Number Terminator</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>AN</b></td>
+
+ <td VALIGN="TOP">Arabic Number</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>CS</b></td>
+
+ <td VALIGN="TOP">Common Number Separator</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>NSM</b></td>
+
+ <td VALIGN="TOP">Non-Spacing Mark</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>BN</b></td>
+
+ <td VALIGN="TOP">Boundary Neutral</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>B</b></td>
+
+ <td VALIGN="TOP">Paragraph Separator</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>S</b></td>
+
+ <td VALIGN="TOP">Segment Separator</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>WS</b></td>
+
+ <td VALIGN="TOP">Whitespace</td>
+
+ </tr>
+
+ <tr>
+
+ <td VALIGN="TOP"><b>ON</b></td>
+
+ <td VALIGN="TOP">Other Neutrals</td>
+
+ </tr>
+
+</table>
+
+
+
+<h3><a NAME="Character Decomposition"></a>Character Decomposition Mapping</h3>
+
+
+
+<p>The decomposition is a normative property of a character. The tags supplied with
+
+certain decomposition mappings generally indicate formatting information. Where no such
+
+tag is given, the mapping is designated as canonical. Conversely, the presence of a
+
+formatting tag also indicates that the mapping is a compatibility mapping and not a
+
+canonical mapping. In the absence of other formatting information in a compatibility
+
+mapping, the tag is used to distinguish it from canonical mappings.</p>
+
+
+
+<p>In some instances a canonical mapping or a compatibility mapping may consist of a
+
+single character. For a canonical mapping, this indicates that the character is a
+
+canonical equivalent of another single character. For a compatibility mapping, this
+
+indicates that the character is a compatibility equivalent of another single character.
+
+The compatibility formatting tags used are:</p>
+
+
+
+<table BORDER="0" CELLSPACING="2" CELLPADDING="0">
+
+ <tr>
+
+ <th>Tag</th>
+
+ <th><p ALIGN="LEFT">Description</th>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><font> </td>
+
+ <td>A font variant (e.g. a blackletter form).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><noBreak> </td>
+
+ <td>A no-break version of a space or hyphen.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><initial> </td>
+
+ <td>An initial presentation form (Arabic).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><medial> </td>
+
+ <td>A medial presentation form (Arabic).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><final> </td>
+
+ <td>A final presentation form (Arabic).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><isolated> </td>
+
+ <td>An isolated presentation form (Arabic).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><circle> </td>
+
+ <td>An encircled form.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><super> </td>
+
+ <td>A superscript form.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><sub> </td>
+
+ <td>A subscript form.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><vertical> </td>
+
+ <td>A vertical layout presentation form.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><wide> </td>
+
+ <td>A wide (or zenkaku) compatibility character.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><narrow> </td>
+
+ <td>A narrow (or hankaku) compatibility character.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><small> </td>
+
+ <td>A small variant form (CNS compatibility).</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><square> </td>
+
+ <td>A CJK squared font variant.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><fraction> </td>
+
+ <td>A vulgar fraction form.</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="CENTER"><compat> </td>
+
+ <td>Otherwise unspecified compatibility character.</td>
+
+ </tr>
+
+</table>
+
+
+
+<p><b>Reminder: </b>There is a difference between decomposition and decomposition mapping.
+
+The decomposition mappings are defined in the UnicodeData, while the decomposition (also
+
+termed "full decomposition") is defined in Chapter 3 to use those mappings
+<i>
+
+recursively.</i>
+
+
+
+<ul>
+
+ <li>The canonical decomposition is formed by recursively applying the canonical mappings,
+
+ then applying the canonical reordering algorithm. </li>
+
+ <li>The compatibility decomposition is formed by recursively applying the canonical <em>and</em>
+
+ compatibility mappings, then applying the canonical reordering algorithm. </li>
+
+</ul>
+
+
+
+<h3><a NAME="Canonical Combining Classes"></a>Canonical Combining Classes</h3>
+
+
+
+<table BORDER="0" CELLSPACING="2" CELLPADDING="0">
+
+ <tr>
+
+ <th><p ALIGN="LEFT">Value</th>
+
+ <th><p ALIGN="LEFT">Description</th>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">0:</td>
+
+ <td>Spacing, split, enclosing, reordrant, and Tibetan subjoined</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">1:</td>
+
+ <td>Overlays and interior</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">7:</td>
+
+ <td>Nuktas</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">8:</td>
+
+ <td>Hiragana/Katakana voicing marks</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">9:</td>
+
+ <td>Viramas</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">10:</td>
+
+ <td>Start of fixed position classes</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">199:</td>
+
+ <td>End of fixed position classes</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">200:</td>
+
+ <td>Below left attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">202:</td>
+
+ <td>Below attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">204:</td>
+
+ <td>Below right attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">208:</td>
+
+ <td>Left attached (reordrant around single base character)</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">210:</td>
+
+ <td>Right attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">212:</td>
+
+ <td>Above left attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">214:</td>
+
+ <td>Above attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">216:</td>
+
+ <td>Above right attached</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">218:</td>
+
+ <td>Below left</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">220:</td>
+
+ <td>Below</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">222:</td>
+
+ <td>Below right</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">224:</td>
+
+ <td>Left (reordrant around single base character)</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">226:</td>
+
+ <td>Right</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">228:</td>
+
+ <td>Above left</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">230:</td>
+
+ <td>Above</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">232:</td>
+
+ <td>Above right</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">233:</td>
+
+ <td>Double below</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">234:</td>
+
+ <td>Double above</td>
+
+ </tr>
+
+ <tr>
+
+ <td ALIGN="RIGHT">240:</td>
+
+ <td>Below (iota subscript)</td>
+
+ </tr>
+
+</table>
+
+
+
+<p><strong>Note: </strong>some of the combining classes in this list do not currently have
+
+members but are specified here for completeness.</p>
+
+
+
+<h3><a NAME="Decompositions and Normalization"></a>Decompositions and Normalization</h3>
+
+
+
+<p>Decomposition is specified in Chapter 3. <a href="http://www.unicode.org/unicode/reports/tr15/"><i>Unicode Technical Report #15:
+
+Normalization Forms</i></a> specifies the interaction between decomposition and normalization. The
+
+most up-to-date version is found on <a HREF="http://www.unicode.org/unicode/reports/tr15/">http://www.unicode.org/unicode/reports/tr15/</a>.
+
+That report specifies how the decompositions defined in UnicodeData.txt are used to derive
+
+normalized forms of Unicode text.</p>
+
+
+
+<p>Note that as of the 2.1.9 update of the Unicode Character Database, the decompositions
+
+in the UnicodeData.txt file can be used to recursively derive the full decomposition in
+
+canonical order, without the need to separately apply canonical reordering. However,
+
+canonical reordering of combining character sequences must still be applied in
+
+decomposition when normalizing source text which contains any combining marks.</p>
+
+
+
+<h3><a NAME="Case Mappings"></a>Case Mappings</h3>
+
+
+
+<p>The case mapping is an informative, default mapping. Case itself, on the other hand,
+
+has normative status. Thus, for example, 0041 LATIN CAPITAL LETTER A is normatively
+
+uppercase, but its lowercase mapping the 0061 LATIN SMALL LETTER A is informative. The
+
+reason for this is that case can be considered to be an inherent property of a particular
+
+character (and is usually, but not always, derivable from the presence of the terms
+
+"CAPITAL" or "SMALL" in the character name), but case mappings between
+
+characters are occasionally influenced by local conventions. For example, certain
+
+languages, such as Turkish, German, French, or Greek may have small deviations from the
+
+default mappings listed in UnicodeData.</p>
+
+
+
+<p>In addition to uppercase and lowercase, because of the inclusion of certain composite
+
+characters for compatibility, such as 01F1 LATIN CAPITAL LETTER DZ, there is a third case,
+
+called <i>titlecase</i>, which is used where the first letter of a word is to be
+
+capitalized (e.g. UPPERCASE, Titlecase, lowercase). An example of such a titlecase letter
+
+is 01F2 LATIN CAPITAL LETTER D WITH SMALL LETTER Z.</p>
+
+
+
+<p>The uppercase, titlecase and lowercase fields are only included for characters that
+
+have a single corresponding character of that type. Composite characters (such as
+
+"339D SQUARE CM") that do not have a single corresponding character of that type
+
+can be cased by decomposition.</p>
+
+
+
+<p>For compatibility with existing parsers, UnicodeData only contains case mappings for
+
+characters where they are one-to-one mappings; it also omits information about
+
+context-sensitive case mappings. Information about these special cases can be found in a
+
+separate data file, SpecialCasing.txt,
+
+which has been added starting with the 2.1.8 update to the Unicode data files.
+
+SpecialCasing.txt contains additional informative case mappings that are either not
+
+one-to-one or which are context-sensitive.</p>
+
+
+
+<h2><a NAME="Property Invariants"></a>Property Invariants</h2>
+
+
+
+<p>Values in UnicodeData.txt are subject to correction as errors are found; however, some
+
+characteristics of the categories themselves can be considered invariants. Applications
+
+may wish to take these invariants into account when choosing how to implement character
+
+properties. The following is a partial list of known invariants for the Unicode Character
+
+Database.</p>
+
+
+
+<h4>Database Fields</h4>
+
+
+
+<ul>
+
+ <li>The number of fields in UnicodeData.txt is fixed. </li>
+
+ <li>The order of the fields is also fixed. <ul>
+
+ <li>Any additional information about character properties to be added in the future will
+
+ appear in separate data tables, rather than being added on to the existing table or by
+
+ subdivision or reinterpretation of existing fields. </li>
+
+ </ul>
+
+ </li>
+
+</ul>
+
+
+
+<h4>General Category</h4>
+
+
+
+<ul>
+
+ <li>There will never be more than 32 General Category values. <ul>
+
+ <li>It is very unlikely that the Unicode Technical Committee will subdivide the General
+
+ Category partition any further, since that can cause implementations to misbehave. Because
+
+ the General Category is limited to 32 values, 5 bits can be used to represent the
+
+ information, and a 32-bit integer can be used as a bitmask to represent arbitrary sets of
+
+ categories. </li>
+
+ </ul>
+
+ </li>
+
+</ul>
+
+
+
+<h4>Combining Classes</h4>
+
+
+
+<ul>
+
+ <li>Combining classes are limited to the values 0 to 255. <ul>
+
+ <li>In practice, there are far fewer than 256 values used. Implementations may take
+
+ advantage of this fact for compression, since only the ordering of the non-zero values
+
+ matters for the Canonical Reordering Algorithm. It is possible for up to 256 values to be
+
+ used in the future; however, UTC decisions in the future may restrict the number of values
+
+ to 128, since this has implementation advantages. [Signed bytes can be used without
+
+ widening to ints in Java, for example.] </li>
+
+ </ul>
+
+ </li>
+
+ <li>All characters other than those of General Category M* have the combining class 0. <ul>
+
+ <li>Currently, all characters other than those of General Category Mn have the value 0.
+
+ However, some characters of General Category Me or Mc may be given non-zero values in the
+
+ future. </li>
+
+ <li>The precise values above the value 0 are not invariant--only the relative ordering is
+
+ considered normative. For example, it is not guaranteed in future versions that the class
+
+ of U+05B4 will be precisely 14. </li>
+
+ </ul>
+
+ </li>
+
+</ul>
+
+
+
+<h4>Case</h4>
+
+
+
+<ul>
+
+ <li>Characters of type Lu, Lt, or Ll are called <i>cased</i>. All characters with an Upper,
+
+ Lower, or Titlecase mapping are cased characters. <ul>
+
+ <li>However, characters with the General Categories of Lu, Ll, or Lt may not always have
+
+ case mappings, and case mappings may vary by locale. (See
+
+ ftp://ftp.unicode.org/Public/UNIDATA/SpecialCasing.txt). </li>
+
+ </ul>
+
+ </li>
+
+</ul>
+
+
+
+<h4>Canonical Decomposition</h4>
+
+
+
+<ul>
+
+ <li>Canonical mappings are always in canonical order. </li>
+
+ <li>Canonical mappings have only the first of a pair possibly further decomposing. </li>
+
+ <li>Canonical decompositions are "transparent" to other character data: <ul>
+
+ <li><tt>BIDI(a) = BIDI(principal(canonicalDecomposition(a))</tt> </li>
+
+ <li><tt>Category(a) = Category(principal(canonicalDecomposition(a))</tt> </li>
+
+ <li><tt>CombiningClass(a) = CombiningClass(principal(canonicalDecomposition(a))</tt><br>
+
+ where principal(a) is the first character not of type Mn, or the first character if all
+
+ characters are of type Mn. </li>
+
+ </ul>
+
+ </li>
+
+ <li>However, because there are sometimes missing case pairs, and because of some legacy
+
+ characters, it is only generally true that: <ul>
+
+ <li><tt>upper(canonicalDecomposition(a)) = canonicalDecomposition(upper(a))</tt> </li>
+
+ <li><tt>lower(canonicalDecomposition(a)) = canonicalDecomposition(lower(a))</tt> </li>
+
+ <li><tt>title(canonicalDecomposition(a)) = canonicalDecomposition(title(a))</tt> </li>
+
+ </ul>
+
+ </li>
+
+</ul>
+
+
+
+<h2><a NAME="Modification History"></a>Modification History</h2>
+
+
+
+<p>This section provides a summary of the changes between update versions of the Unicode
+
+Standard.</p>
+
+
+
+<h3><a href="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 3.0.0"> Unicode 3.0.0</a></h3>
+
+
+
+<p>Modifications made for Version 3.0.0 of UnicodeData.txt include many new characters and
+
+a number of property changes. These are summarized in Appendex D of <em>The Unicode
+
+Standard, Version 3.0.</em></p>
+
+
+
+<h3><a HREF="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 2.1.9">Unicode 2.1.9</a> </h3>
+
+
+
+<p>Modifications made for Version 2.1.9 of UnicodeData.txt include:
+
+
+
+<ul>
+
+ <li>Corrected combining class for U+05AE HEBREW ACCENT ZINOR. </li>
+
+ <li>Corrected combining class for U+20E1 COMBINING LEFT RIGHT ARROW ABOVE </li>
+
+ <li>Corrected combining class for U+0F35 and U+0F37 to 220. </li>
+
+ <li>Corrected combining class for U+0F71 to 129. </li>
+
+ <li>Added a decomposition for U+0F0C TIBETAN MARK DELIMITER TSHEG BSTAR. </li>
+
+ <li>Added decompositions for several Greek symbol letters: U+03D0..U+03D2, U+03D5,
+
+ U+03D6, U+03F0..U+03F2. </li>
+
+ <li>Removed decompositions from the conjoining jamo block: U+1100..U+11F8. </li>
+
+ <li>Changes to decomposition mappings for some Tibetan vowels for consistency in
+
+ normalization. (U+0F71, U+0F73, U+0F77, U+0F79, U+0F81) </li>
+
+ <li>Updated the decomposition mappings for several Vietnamese characters with two diacritics
+
+ (U+1EAC, U+1EAD, U+1EB6, U+1EB7, U+1EC6, U+1EC7, U+1ED8, U+1ED9), so that the recursive
+
+ decomposition can be generated directly in canonically reordered form (not a normative
+
+ change). </li>
+
+ <li>Updated the decomposition mappings for several Arabic compatibility characters involving
+
+ shadda (U+FC5E..U+FC62, U+FCF2..U+FCF4), and two Latin characters (U+1E1C, U+1E1D), so
+
+ that the decompositions are generated directly in canonically reordered form (not a
+
+ normative change). </li>
+
+ <li>Changed BIDI category for: U+00A0 NO-BREAK SPACE, U+2007 FIGURE SPACE, U+2028 LINE
+
+ SEPARATOR. </li>
+
+ <li>Changed BIDI category for extenders of General Category Lm: U+3005, U+3021..U+3035,
+
+ U+FF9E, U+FF9F. </li>
+
+ <li>Changed General Category and BIDI category for the Greek numeral signs: U+0374, U+0375. </li>
+
+ <li>Corrected General Category for U+FFE8 HALFWIDTH FORMS LIGHT VERTICAL. </li>
+
+ <li>Added Unicode 1.0 names for many Tibetan characters (informative). </li>
+
+</ul>
+
+
+
+<h3><a HREF="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 2.1.8">Unicode 2.1.8</a> </h3>
+
+
+
+<p>Modifications made for Version 2.1.8 of UnicodeData.txt include:
+
+
+
+<ul>
+
+ <li>Added combining class 240 for U+0345 COMBINING GREEK YPOGEGRAMMENI so that
+
+ decompositions involving iota subscript are derivable directly in canonically reordered
+
+ form; this also has a bearing on simplification of casing of polytonic Greek. </li>
+
+ <li>Changes in decompositions related to Greek tonos. These result from the clarification
+
+ that monotonic Greek "tonos" should be equated with U+0301 COMBINING ACUTE,
+
+ rather than with U+030D COMBINING VERTICAL LINE ABOVE. (All Greek characters in the Greek
+
+ block involving "tonos"; some Greek characters in the polytonic Greek in the
+
+ 1FXX block.) </li>
+
+ <li>Changed decompositions involving dialytika tonos. (U+0390, U+03B0) </li>
+
+ <li>Changed ternary decompositions to binary. (U+0CCB, U+FB2C, U+FB2D) These changes
+
+ simplify normalization. </li>
+
+ <li>Removed canonical decomposition for Latin Candrabindu. (U+0310) </li>
+
+ <li>Corrected error in canonical decomposition for U+1FF4. </li>
+
+ <li>Added compatibility decompositions to clarify collation tables. (U+2100, U+2101, U+2105,
+
+ U+2106, U+1E9A) </li>
+
+ <li>A series of general category changes to assist the convergence of of Unicode definition
+
+ of identifier with ISO TR 10176: <ul>
+
+ <li>So > Lo: U+0950, U+0AD0, U+0F00, U+0F88..U+0F8B </li>
+
+ <li>Po > Lo: U+0E2F, U+0EAF, U+3006 </li>
+
+ <li>Lm > Sk: U+309B, U+309C </li>
+
+ <li>Po > Pc: U+30FB, U+FF65 </li>
+
+ <li>Ps/Pe > Mn: U+0F3E, U+0F3F </li>
+
+ </ul>
+
+ </li>
+
+ <li>A series of bidi property changes for consistency. <ul>
+
+ <li>L > ET: U+09F2, U+09F3 </li>
+
+ <li>ON > L: U+3007 </li>
+
+ <li>L > ON: U+0F3A..U+0F3D, U+037E, U+0387 </li>
+
+ </ul>
+
+ </li>
+
+ <li>Add case mapping: U+01A6 <-> U+0280 </li>
+
+ <li>Updated symmetric swapping value for guillemets: U+00AB, U+00BB, U+2039, U+203A. </li>
+
+ <li>Changes to combining class values. Most Indic fixed position class non-spacing marks
+
+ were changed to combining class 0. This fixes some inconsistencies in how canonical
+
+ reordering would apply to Indic scripts, including Tibetan. Indic interacting top/bottom
+
+ fixed position classes were merged into single (non-zero) classes as part of this change.
+
+ Tibetan subjoined consonants are changed from combining class 6 to combining class 0. Thai
+
+ pinthu (U+0E3A) moved to combining class 9. Moved two Devanagari stress marks into generic
+
+ above and below combining classes (U+0951, U+0952). </li>
+
+ <li>Corrected placement of semicolon near symmetric swapping field. (U+FA0E, etc., scattered
+
+ positions to U+FA29) </li>
+
+</ul>
+
+
+
+<h3>Version 2.1.7</h3>
+
+
+
+<p><i>This version was for internal change tracking only, and never publicly released.</i></p>
+
+
+
+<h3>Version 2.1.6</h3>
+
+
+
+<p><i>This version was for internal change tracking only, and never publicly released.</i></p>
+
+
+
+<h3><a HREF="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 2.1.5">Unicode 2.1.5</a> </h3>
+
+
+
+<p>Modifications made for Version 2.1.5 of UnicodeData.txt include:
+
+
+
+<ul>
+
+ <li>Changed decomposition for U+FF9E and U+FF9F so that correct collation weighting will
+
+ automatically result from the canonical equivalences. </li>
+
+ <li>Removed canonical decompositions for U+04D4, U+04D5, U+04D8, U+04D9, U+04E0, U+04E1,
+
+ U+04E8, U+04E9 (the implication being that no canonical equivalence is claimed between
+
+ these 8 characters and similar Latin letters), and updated 4 canonical decompositions for
+
+ U+04DB, U+04DC, U+04EA, U+04EB to reflect the implied difference in the base character. </li>
+
+ <li>Added Pi, and Pf categories and assigned the relevant quotation marks to those
+
+ categories, based on the Unicode Technical Corrigendum on Quotation Characters. </li>
+
+ <li>Updating of many bidi properties, following the advice of the ad hoc committee on bidi,
+
+ and to make the bidi properties of compatibility characters more consistent. </li>
+
+ <li>Changed category of several Tibetan characters: U+0F3E, U+0F3F, U+0F88..U+0F8B to make
+
+ them non-combining, reflecting the combined opinion of Tibetan experts. </li>
+
+ <li>Added case mapping for U+03F2. </li>
+
+ <li>Corrected case mapping for U+0275. </li>
+
+ <li>Added titlecase mappings for U+03D0, U+03D1, U+03D5, U+03D6, U+03F0.. U+03F2. </li>
+
+ <li>Corrected compatibility label for U+2121. </li>
+
+ <li>Add specific entries for all the CJK compatibility ideographs, U+F900..U+FA2D, so the
+
+ canonical decomposition for each (the URO character it is equivalent to) can be carried in
+
+ the database. </li>
+
+</ul>
+
+
+
+<h3>Version 2.1.4</h3>
+
+
+
+<p><i>This version was for internal change tracking only, and never publicly released.</i></p>
+
+
+
+<h3>Version 2.1.3</h3>
+
+
+
+<p><i>This version was for internal change tracking only, and never publicly released.</i></p>
+
+
+
+<h3><a HREF="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 2.1.2">Unicode 2.1.2</a> </h3>
+
+
+
+<p>Modifications made in updating UnicodeData.txt to Version 2.1.2 for the Unicode
+
+Standard, Version 2.1 (from Version 2.0) include:
+
+
+
+<ul>
+
+ <li>Added two characters (U+20AC and U+FFFC). </li>
+
+ <li>Amended bidi properties for U+0026, U+002E, U+0040, U+2007. </li>
+
+ <li>Corrected case mappings for U+018E, U+019F, U+01DD, U+0258, U+0275, U+03C2, U+1E9B. </li>
+
+ <li>Changed combining order class for U+0F71. </li>
+
+ <li>Corrected canonical decompositions for U+0F73, U+1FBE. </li>
+
+ <li>Changed decomposition for U+FB1F from compatibility to canonical. </li>
+
+ <li>Added compatibility decompositions for U+FBE8, U+FBE9, U+FBF9..U+FBFB. </li>
+
+ <li>Corrected compatibility decompositions for U+2469, U+246A, U+3358. </li>
+
+</ul>
+
+
+
+<h3>Version 2.1.1</h3>
+
+
+
+<p><i>This version was for internal change tracking only, and never publicly released.</i></p>
+
+
+
+<h3><a HREF="http://www.unicode.org/unicode/standard/versions/enumeratedversions.html#Unicode 2.0.0">Unicode 2.0.0</a> </h3>
+
+
+
+<p>The modifications made in updating UnicodeData.txt for the Unicode
+
+Standard, Version 2.0 include:
+
+
+
+<ul>
+
+ <li>Fixed decompositions with TONOS to use correct NSM: 030D. </li>
+
+ <li>Removed old Hangul Syllables; mapping to new characters are in a separate table. </li>
+
+ <li>Marked compatibility decompositions with additional tags. </li>
+
+ <li>Changed old tag names for clarity. </li>
+
+ <li>Revision of decompositions to use first-level decomposition, instead of maximal
+
+ decomposition. </li>
+
+ <li>Correction of all known errors in decompositions from earlier versions. </li>
+
+ <li>Added control code names (as old Unicode names). </li>
+
+ <li>Added Hangul Jamo decompositions. </li>
+
+ <li>Added Number category to match properties list in book. </li>
+
+ <li>Fixed categories of Koranic Arabic marks. </li>
+
+ <li>Fixed categories of precomposed characters to match decomposition where possible. </li>
+
+ <li>Added Hebrew cantillation marks and the Tibetan script. </li>
+
+ <li>Added place holders for ranges such as CJK Ideographic Area and the Private Use Area. </li>
+
+ <li>Added categories Me, Sk, Pc, Nl, Cs, Cf, and rectified a number of mistakes in the
+
+ database. </li>
+
+</ul>
+
+</body>
+
+</html>
+
#!../../miniperl
-$UnicodeData = "UnicodeData-Latest.txt";
+$UnicodeData = "Unicode.300";
# Note: we try to keep filenames unique within first 8 chars. Using
# subdirectories for the following helps.
else {
open(OUT, ">$table.pl") or die "Can't create $table.pl: $!\n";
}
+ print OUT <<EOH;
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+EOH
print OUT <<"END";
return <<'END';
END
print "Block\n";
open(UD, 'Blocks.txt') or die "Can't open blocks.txt: $!\n";
open(OUT, ">Block.pl") or die "Can't create $table.pl: $!\n";
+print OUT <<EOH;
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+EOH
print OUT <<"END";
return <<'END';
END
print OUT "$code $last $name\n";
$name =~ s/\s+//g;
open(BLOCK, ">In/$name.pl");
+ print BLOCK <<EOH;
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+EOH
print BLOCK <<"END2";
return <<'END';
$code $last
$split = '($code, $name, $link, $linkgroup) = split(/; */);';
}
elsif ($table =~ /^Jamo/) {
- open(UD, "Jamo-2.txt") or warn "Can't open $table: $!";
+ open(UD, "Jamo.txt") or warn "Can't open $table: $!";
$split = '($code, $short, $name) = split(/; */); $code =~ s/^U\+//;';
}
@unicode = sort keys %unicode;
print "EqUnicode\n";
-if (open(EQ_UNICODE, ">Eq/Unicode")) {
+if (open(OUT, ">Eq/Unicode.pl")) {
+ print OUT <<EOH;
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+return <<'END';
+EOH
foreach my $c (@unicode) {
- print EQ_UNICODE "$c @{$unicode{$c}}\n";
+ print OUT "$c @{$unicode{$c}}\n";
}
- close EQ_UNICODE;
+ print OUT "END\n";
+ close OUT;
} else {
- die "$0: failed to open Eq/Unicode for writing: $!\n";
+ die "$0: failed to open Eq/Unicode.pl for writing: $!\n";
}
print "EqLatin1\n";
-if (open(EQ_LATIN1, ">Eq/Latin1")) {
+if (open(OUT, ">Eq/Latin1.pl")) {
+ print OUT <<EOH;
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+return <<'END';
+EOH
foreach my $c (@unicode) {
last if hex($c) > 255;
my @c = grep { hex($_) < 256 } @{$unicode{$c}};
next unless @c;
- print EQ_LATIN1 "$c @c\n";
+ print OUT "$c @c\n";
}
- close EQ_LATIN1;
+ print OUT "END\n";
+ close OUT;
} else {
- die "$0: failed to open Eq/Latin1 for writing: $!\n";
+ die "$0: failed to open Eq/Latin1.pl for writing: $!\n";
}
# eof
Perl_safesysmalloc => "Perl_safemalloc",
Perl_safesysrealloc => "Perl_saferealloc",
Perl_set_numeric_local => "perl_set_numeric_local",
- Perl_set_numeric_standard => "perl_set_numeric_standard");
+ Perl_set_numeric_standard => "perl_set_numeric_standard",
+ Perl_malloc => "malloc",
+ Perl_mfree => "free",
+ Perl_realloc => "realloc",
+ Perl_calloc => "calloc",);
my $bincompat5005 = join("|", keys %bincompat5005);
-while (@ARGV)
- {
- my $flag = shift;
- $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
- $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/);
- $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
- $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
- }
+while (@ARGV) {
+ my $flag = shift;
+ $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
+ $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/);
+ $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
+ $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
+}
my @PLATFORM = qw(aix win32 os2);
my %PLATFORM;
if ($PLATFORM eq 'aix') {
# Nothing for now.
-} elsif ($PLATFORM eq 'win32') {
+}
+elsif ($PLATFORM eq 'win32') {
$CCTYPE = "MSVC" unless defined $CCTYPE;
foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym) {
s!^!..\\!;
unless ($PLATFORM eq 'win32') {
open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n";
- while (<CFG>)
- {
+ while (<CFG>) {
if (/^(?:ccflags|optimize)='(.+)'$/) {
$_ = $1;
$define{$1} = 1 while /-D(\w+)/g;
}
open(CFG,$config_h) || die "Cannot open $config_h: $!\n";
-while (<CFG>)
- {
- $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
- $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/;
- $define{$1} = 1 if /^\s*#\s*define\s+(USE_PERLIO)\b/;
- $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/;
- $define{$1} = 1 if /^\s*#\s*define\s+(PERL_BINCOMPAT_5005)\b/;
- }
+while (<CFG>) {
+ $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
+ $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/;
+ $define{$1} = 1 if /^\s*#\s*define\s+(USE_PERLIO)\b/;
+ $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/;
+ $define{$1} = 1 if /^\s*#\s*define\s+(PERL_BINCOMPAT_5005)\b/;
+}
close(CFG);
if ($PLATFORM eq 'win32') {
print "EXPORTS\n";
# output_symbol("perl_alloc");
output_symbol("perl_get_host_info");
- output_symbol("perl_alloc_using");
+ output_symbol("perl_alloc_override");
# output_symbol("perl_construct");
# output_symbol("perl_destruct");
# output_symbol("perl_free");
}
print "EXPORTS\n";
}
-} elsif ($PLATFORM eq 'os2') {
+}
+elsif ($PLATFORM eq 'os2') {
($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
$v .= '-thread' if $ARCHNAME =~ /-thread/;
#$sum = 0;
DATA LOADONCALL NONSHARED MULTIPLE
EXPORTS
---EOP---
-} elsif ($PLATFORM eq 'aix') {
+}
+elsif ($PLATFORM eq 'aix') {
print "#!\n";
}
}
if ($PLATFORM eq 'win32') {
-skip_symbols [qw(
-PL_statusvalue_vms
-PL_archpat_auto
-PL_cryptseen
-PL_DBcv
-PL_generation
-PL_lastgotoprobe
-PL_linestart
-PL_modcount
-PL_pending_ident
-PL_sortcxix
-PL_sublex_info
-PL_timesbuf
-main
-Perl_ErrorNo
-Perl_GetVars
-Perl_do_exec3
-Perl_do_ipcctl
-Perl_do_ipcget
-Perl_do_msgrcv
-Perl_do_msgsnd
-Perl_do_semop
-Perl_do_shmio
-Perl_dump_fds
-Perl_init_thread_intern
-Perl_my_bzero
-Perl_my_htonl
-Perl_my_ntohl
-Perl_my_swap
-Perl_my_chsize
-Perl_same_dirent
-Perl_setenv_getix
-Perl_unlnk
-Perl_watch
-Perl_safexcalloc
-Perl_safexmalloc
-Perl_safexfree
-Perl_safexrealloc
-Perl_my_memcmp
-Perl_my_memset
-PL_cshlen
-PL_cshname
-PL_opsave
-
-Perl_do_exec
-Perl_getenv_len
-Perl_my_pclose
-Perl_my_popen
-)];
-} elsif ($PLATFORM eq 'aix') {
+ skip_symbols [qw(
+ PL_statusvalue_vms
+ PL_archpat_auto
+ PL_cryptseen
+ PL_DBcv
+ PL_generation
+ PL_lastgotoprobe
+ PL_linestart
+ PL_modcount
+ PL_pending_ident
+ PL_sortcxix
+ PL_sublex_info
+ PL_timesbuf
+ main
+ Perl_ErrorNo
+ Perl_GetVars
+ Perl_do_exec3
+ Perl_do_ipcctl
+ Perl_do_ipcget
+ Perl_do_msgrcv
+ Perl_do_msgsnd
+ Perl_do_semop
+ Perl_do_shmio
+ Perl_dump_fds
+ Perl_init_thread_intern
+ Perl_my_bzero
+ Perl_my_htonl
+ Perl_my_ntohl
+ Perl_my_swap
+ Perl_my_chsize
+ Perl_same_dirent
+ Perl_setenv_getix
+ Perl_unlnk
+ Perl_watch
+ Perl_safexcalloc
+ Perl_safexmalloc
+ Perl_safexfree
+ Perl_safexrealloc
+ Perl_my_memcmp
+ Perl_my_memset
+ PL_cshlen
+ PL_cshname
+ PL_opsave
+ Perl_do_exec
+ Perl_getenv_len
+ Perl_my_pclose
+ Perl_my_popen
+ )];
+}
+elsif ($PLATFORM eq 'aix') {
skip_symbols([qw(
-Perl_dump_fds
-Perl_ErrorNo
-Perl_GetVars
-Perl_my_bcopy
-Perl_my_bzero
-Perl_my_chsize
-Perl_my_htonl
-Perl_my_memcmp
-Perl_my_memset
-Perl_my_ntohl
-Perl_my_swap
-Perl_safexcalloc
-Perl_safexfree
-Perl_safexmalloc
-Perl_safexrealloc
-Perl_same_dirent
-Perl_unlnk
-PL_cryptseen
-PL_opsave
-PL_statusvalue_vms
-PL_sys_intern
-)]);
-}
-
-if ($PLATFORM eq 'os2') {
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ Perl_my_bcopy
+ Perl_my_bzero
+ Perl_my_chsize
+ Perl_my_htonl
+ Perl_my_memcmp
+ Perl_my_memset
+ Perl_my_ntohl
+ Perl_my_swap
+ Perl_safexcalloc
+ Perl_safexfree
+ Perl_safexmalloc
+ Perl_safexrealloc
+ Perl_same_dirent
+ Perl_unlnk
+ PL_cryptseen
+ PL_opsave
+ PL_statusvalue_vms
+ PL_sys_intern
+ )]);
+}
+elsif ($PLATFORM eq 'os2') {
emit_symbols([qw(
-ctermid
-get_sysinfo
-Perl_OS2_init
-OS2_Perl_data
-dlopen
-dlsym
-dlerror
-my_tmpfile
-my_tmpnam
-my_flock
-malloc_mutex
-threads_mutex
-nthreads
-nthreads_cond
-os2_cond_wait
-os2_stat
-pthread_join
-pthread_create
-pthread_detach
-XS_Cwd_change_drive
-XS_Cwd_current_drive
-XS_Cwd_extLibpath
-XS_Cwd_extLibpath_set
-XS_Cwd_sys_abspath
-XS_Cwd_sys_chdir
-XS_Cwd_sys_cwd
-XS_Cwd_sys_is_absolute
-XS_Cwd_sys_is_relative
-XS_Cwd_sys_is_rooted
-XS_DynaLoader_mod2fname
-XS_File__Copy_syscopy
-Perl_Register_MQ
-Perl_Deregister_MQ
-Perl_Serve_Messages
-Perl_Process_Messages
-init_PMWIN_entries
-PMWIN_entries
-Perl_hab_GET
-)]);
+ ctermid
+ get_sysinfo
+ Perl_OS2_init
+ OS2_Perl_data
+ dlopen
+ dlsym
+ dlerror
+ my_tmpfile
+ my_tmpnam
+ my_flock
+ malloc_mutex
+ threads_mutex
+ nthreads
+ nthreads_cond
+ os2_cond_wait
+ os2_stat
+ pthread_join
+ pthread_create
+ pthread_detach
+ XS_Cwd_change_drive
+ XS_Cwd_current_drive
+ XS_Cwd_extLibpath
+ XS_Cwd_extLibpath_set
+ XS_Cwd_sys_abspath
+ XS_Cwd_sys_chdir
+ XS_Cwd_sys_cwd
+ XS_Cwd_sys_is_absolute
+ XS_Cwd_sys_is_relative
+ XS_Cwd_sys_is_rooted
+ XS_DynaLoader_mod2fname
+ XS_File__Copy_syscopy
+ Perl_Register_MQ
+ Perl_Deregister_MQ
+ Perl_Serve_Messages
+ Perl_Process_Messages
+ init_PMWIN_entries
+ PMWIN_entries
+ Perl_hab_GET
+ )]);
}
-if ($define{'PERL_OBJECT'}) {
- skip_symbols [qw(
- Perl_getenv_len
- Perl_my_popen
- Perl_my_pclose
- )];
+unless ($define{'DEBUGGING'}) {
+ skip_symbols [qw(
+ Perl_deb
+ Perl_deb_growlevel
+ Perl_debop
+ Perl_debprofdump
+ Perl_debstack
+ Perl_debstackptrs
+ Perl_runops_debug
+ Perl_sv_peek
+ PL_block_type
+ PL_watchaddr
+ PL_watchok
+ )];
+}
+
+if ($define{'PERL_IMPLICIT_SYS'}) {
+ skip_symbols [qw(
+ Perl_getenv_len
+ Perl_my_popen
+ Perl_my_pclose
+ )];
+}
+else {
+ skip_symbols [qw(
+ PL_Mem
+ PL_MemShared
+ PL_MemParse
+ PL_Env
+ PL_StdIO
+ PL_LIO
+ PL_Dir
+ PL_Sock
+ PL_Proc
+ )];
+}
+
+if ($define{'MYMALLOC'}) {
+ emit_symbols [qw(
+ Perl_dump_mstats
+ Perl_malloc
+ Perl_mfree
+ Perl_realloc
+ Perl_calloc
+ )];
}
else {
- skip_symbols [qw(
- PL_Dir
- PL_Env
- PL_LIO
- PL_Mem
- PL_Proc
- PL_Sock
- PL_StdIO
- )];
-}
-
-if ($define{'MYMALLOC'})
- {
- emit_symbols [qw(
- Perl_dump_mstats
- Perl_malloc
- Perl_mfree
- Perl_realloc
- Perl_calloc)];
- }
-else
- {
- skip_symbols [qw(
- Perl_dump_mstats
- Perl_malloc
- Perl_mfree
- Perl_realloc
- Perl_calloc
- Perl_malloced_size)];
- }
-
-unless ($define{'USE_THREADS'})
- {
- skip_symbols [qw(
-PL_thr_key
-PL_sv_mutex
-PL_strtab_mutex
-PL_svref_mutex
-PL_malloc_mutex
-PL_cred_mutex
-PL_eval_mutex
-PL_eval_cond
-PL_eval_owner
-PL_threads_mutex
-PL_nthreads
-PL_nthreads_cond
-PL_threadnum
-PL_threadsv_names
-PL_thrsv
-PL_vtbl_mutex
-Perl_getTHR
-Perl_setTHR
-Perl_condpair_magic
-Perl_new_struct_thread
-Perl_per_thread_magicals
-Perl_thread_create
-Perl_find_threadsv
-Perl_unlock_condpair
-Perl_magic_mutexfree
-)];
- }
-unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'}
- or $define{'PERL_OBJECT'})
-{
- skip_symbols [qw(
- Perl_croak_nocontext
- Perl_die_nocontext
- Perl_deb_nocontext
- Perl_form_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
- )];
- }
-
-unless ($define{'FAKE_THREADS'})
- {
- skip_symbols [qw(PL_curthr)];
- }
-
-sub readvar
-{
- my $file = shift;
- my $proc = shift || sub { "PL_$_[2]" };
- open(VARS,$file) || die "Cannot open $file: $!\n";
- my @syms;
- while (<VARS>)
- {
- # All symbols have a Perl_ prefix because that's what embed.h
- # sticks in front of them.
- push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/);
- }
- close(VARS);
- return \@syms;
-}
-
-if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
- {
- my $thrd = readvar($thrdvar_h);
- skip_symbols $thrd;
- }
-
-if ($define{'MULTIPLICITY'})
- {
- my $interp = readvar($intrpvar_h);
- skip_symbols $interp;
- }
-
-if ($define{'PERL_GLOBAL_STRUCT'})
- {
- my $global = readvar($perlvars_h);
- skip_symbols $global;
- emit_symbols [qw(Perl_GetVars)];
- emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
- }
-
-unless ($define{'DEBUGGING'})
- {
- skip_symbols [qw(
- Perl_deb
- Perl_deb_growlevel
- Perl_debop
- Perl_debprofdump
- Perl_debstack
- Perl_debstackptrs
- Perl_runops_debug
- Perl_sv_peek
- PL_block_type
- PL_watchaddr
- PL_watchok)];
- }
-
-if ($PLATFORM eq 'win32' && $define{'HAVE_DES_FCRYPT'})
- {
- emit_symbols [qw(win32_crypt)];
- }
+ skip_symbols [qw(
+ PL_malloc_mutex
+ Perl_dump_mstats
+ Perl_malloc
+ Perl_mfree
+ Perl_realloc
+ Perl_calloc
+ Perl_malloced_size
+ )];
+}
+
+unless ($define{'USE_THREADS'}) {
+ skip_symbols [qw(
+ PL_thr_key
+ PL_sv_mutex
+ PL_strtab_mutex
+ PL_svref_mutex
+ PL_malloc_mutex
+ PL_cred_mutex
+ PL_eval_mutex
+ PL_eval_cond
+ PL_eval_owner
+ PL_threads_mutex
+ PL_nthreads
+ PL_nthreads_cond
+ PL_threadnum
+ PL_threadsv_names
+ PL_thrsv
+ PL_vtbl_mutex
+ Perl_getTHR
+ Perl_setTHR
+ Perl_condpair_magic
+ Perl_new_struct_thread
+ Perl_per_thread_magicals
+ Perl_thread_create
+ Perl_find_threadsv
+ Perl_unlock_condpair
+ Perl_magic_mutexfree
+ )];
+}
+
+unless ($define{'USE_ITHREADS'}) {
+ skip_symbols [qw(
+ PL_ptr_table
+ Perl_dirp_dup
+ Perl_cx_dup
+ Perl_si_dup
+ Perl_any_dup
+ Perl_ss_dup
+ Perl_fp_dup
+ Perl_gp_dup
+ Perl_he_dup
+ Perl_mg_dup
+ Perl_re_dup
+ Perl_sv_dup
+ Perl_sys_intern_dup
+ Perl_ptr_table_fetch
+ Perl_ptr_table_new
+ Perl_ptr_table_split
+ Perl_ptr_table_store
+ perl_clone
+ perl_clone_using
+ )];
+}
+
+unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
+ skip_symbols [qw(
+ Perl_croak_nocontext
+ Perl_die_nocontext
+ Perl_deb_nocontext
+ Perl_form_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
+ )];
+}
+
+unless ($define{'PERL_IMPLICIT_SYS'}) {
+ skip_symbols [qw(
+ perl_alloc_using
+ perl_clone_using
+ )];
+}
+
+unless ($define{'FAKE_THREADS'}) {
+ skip_symbols [qw(PL_curthr)];
+}
+
+sub readvar {
+ my $file = shift;
+ my $proc = shift || sub { "PL_$_[2]" };
+ open(VARS,$file) || die "Cannot open $file: $!\n";
+ my @syms;
+ while (<VARS>) {
+ # All symbols have a Perl_ prefix because that's what embed.h
+ # sticks in front of them.
+ push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/);
+ }
+ close(VARS);
+ return \@syms;
+}
+
+if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'}) {
+ my $thrd = readvar($thrdvar_h);
+ skip_symbols $thrd;
+}
+
+if ($define{'MULTIPLICITY'}) {
+ my $interp = readvar($intrpvar_h);
+ skip_symbols $interp;
+}
+
+if ($define{'PERL_GLOBAL_STRUCT'}) {
+ my $global = readvar($perlvars_h);
+ skip_symbols $global;
+ emit_symbol('Perl_GetVars');
+ emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
+}
# functions from *.sym files
my @syms = ($global_sym, $pp_sym, $globvar_sym);
-if ($define{'USE_PERLIO'})
- {
+if ($define{'USE_PERLIO'}) {
push @syms, $perlio_sym;
- }
-
-for my $syms (@syms)
- {
- open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n";
- while (<GLOBAL>)
- {
- next if (!/^[A-Za-z]/);
- # Functions have a Perl_ prefix
- # Variables have a PL_ prefix
- chomp($_);
- my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
- $symbol .= $_;
- emit_symbol($symbol) unless exists $skip{$symbol};
- }
- close(GLOBAL);
- }
+}
+
+for my $syms (@syms) {
+ open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n";
+ while (<GLOBAL>) {
+ next if (!/^[A-Za-z]/);
+ # Functions have a Perl_ prefix
+ # Variables have a PL_ prefix
+ chomp($_);
+ my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
+ $symbol .= $_;
+ emit_symbol($symbol) unless exists $skip{$symbol};
+ }
+ close(GLOBAL);
+}
# variables
my $glob = readvar($intrpvar_h);
emit_symbols $glob;
}
-
unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'}) {
my $glob = readvar($thrdvar_h);
emit_symbols $glob;
if ($PLATFORM eq 'win32') {
foreach my $symbol (qw(
-boot_DynaLoader
-Perl_getTHR
-Perl_init_os_extras
-Perl_setTHR
-Perl_thread_create
-Perl_win32_init
-RunPerl
-GetPerlInterpreter
-SetPerlInterpreter
-win32_errno
-win32_environ
-win32_stdin
-win32_stdout
-win32_stderr
-win32_ferror
-win32_feof
-win32_strerror
-win32_fprintf
-win32_printf
-win32_vfprintf
-win32_vprintf
-win32_fread
-win32_fwrite
-win32_fopen
-win32_fdopen
-win32_freopen
-win32_fclose
-win32_fputs
-win32_fputc
-win32_ungetc
-win32_getc
-win32_fileno
-win32_clearerr
-win32_fflush
-win32_ftell
-win32_fseek
-win32_fgetpos
-win32_fsetpos
-win32_rewind
-win32_tmpfile
-win32_abort
-win32_fstat
-win32_stat
-win32_pipe
-win32_popen
-win32_pclose
-win32_rename
-win32_setmode
-win32_lseek
-win32_tell
-win32_dup
-win32_dup2
-win32_open
-win32_close
-win32_eof
-win32_read
-win32_write
-win32_spawnvp
-win32_mkdir
-win32_rmdir
-win32_chdir
-win32_flock
-win32_execv
-win32_execvp
-win32_htons
-win32_ntohs
-win32_htonl
-win32_ntohl
-win32_inet_addr
-win32_inet_ntoa
-win32_socket
-win32_bind
-win32_listen
-win32_accept
-win32_connect
-win32_send
-win32_sendto
-win32_recv
-win32_recvfrom
-win32_shutdown
-win32_closesocket
-win32_ioctlsocket
-win32_setsockopt
-win32_getsockopt
-win32_getpeername
-win32_getsockname
-win32_gethostname
-win32_gethostbyname
-win32_gethostbyaddr
-win32_getprotobyname
-win32_getprotobynumber
-win32_getservbyname
-win32_getservbyport
-win32_select
-win32_endhostent
-win32_endnetent
-win32_endprotoent
-win32_endservent
-win32_getnetent
-win32_getnetbyname
-win32_getnetbyaddr
-win32_getprotoent
-win32_getservent
-win32_sethostent
-win32_setnetent
-win32_setprotoent
-win32_setservent
-win32_getenv
-win32_putenv
-win32_perror
-win32_setbuf
-win32_setvbuf
-win32_flushall
-win32_fcloseall
-win32_fgets
-win32_gets
-win32_fgetc
-win32_putc
-win32_puts
-win32_getchar
-win32_putchar
-win32_malloc
-win32_calloc
-win32_realloc
-win32_free
-win32_sleep
-win32_times
-win32_alarm
-win32_open_osfhandle
-win32_get_osfhandle
-win32_ioctl
-win32_utime
-win32_uname
-win32_wait
-win32_waitpid
-win32_kill
-win32_str_os_error
-win32_opendir
-win32_readdir
-win32_telldir
-win32_seekdir
-win32_rewinddir
-win32_closedir
-win32_longpath
-win32_os_id
- )) {
+ boot_DynaLoader
+ Perl_getTHR
+ Perl_init_os_extras
+ Perl_setTHR
+ Perl_thread_create
+ Perl_win32_init
+ RunPerl
+ GetPerlInterpreter
+ SetPerlInterpreter
+ win32_errno
+ win32_environ
+ win32_stdin
+ win32_stdout
+ win32_stderr
+ win32_ferror
+ win32_feof
+ win32_strerror
+ win32_fprintf
+ win32_printf
+ win32_vfprintf
+ win32_vprintf
+ win32_fread
+ win32_fwrite
+ win32_fopen
+ win32_fdopen
+ win32_freopen
+ win32_fclose
+ win32_fputs
+ win32_fputc
+ win32_ungetc
+ win32_getc
+ win32_fileno
+ win32_clearerr
+ win32_fflush
+ win32_ftell
+ win32_fseek
+ win32_fgetpos
+ win32_fsetpos
+ win32_rewind
+ win32_tmpfile
+ win32_abort
+ win32_fstat
+ win32_stat
+ win32_pipe
+ win32_popen
+ win32_pclose
+ win32_rename
+ win32_setmode
+ win32_lseek
+ win32_tell
+ win32_dup
+ win32_dup2
+ win32_open
+ win32_close
+ win32_eof
+ win32_read
+ win32_write
+ win32_spawnvp
+ win32_mkdir
+ win32_rmdir
+ win32_chdir
+ win32_flock
+ win32_execv
+ win32_execvp
+ win32_htons
+ win32_ntohs
+ win32_htonl
+ win32_ntohl
+ win32_inet_addr
+ win32_inet_ntoa
+ win32_socket
+ win32_bind
+ win32_listen
+ win32_accept
+ win32_connect
+ win32_send
+ win32_sendto
+ win32_recv
+ win32_recvfrom
+ win32_shutdown
+ win32_closesocket
+ win32_ioctlsocket
+ win32_setsockopt
+ win32_getsockopt
+ win32_getpeername
+ win32_getsockname
+ win32_gethostname
+ win32_gethostbyname
+ win32_gethostbyaddr
+ win32_getprotobyname
+ win32_getprotobynumber
+ win32_getservbyname
+ win32_getservbyport
+ win32_select
+ win32_endhostent
+ win32_endnetent
+ win32_endprotoent
+ win32_endservent
+ win32_getnetent
+ win32_getnetbyname
+ win32_getnetbyaddr
+ win32_getprotoent
+ win32_getservent
+ win32_sethostent
+ win32_setnetent
+ win32_setprotoent
+ win32_setservent
+ win32_getenv
+ win32_putenv
+ win32_perror
+ win32_setbuf
+ win32_setvbuf
+ win32_flushall
+ win32_fcloseall
+ win32_fgets
+ win32_gets
+ win32_fgetc
+ win32_putc
+ win32_puts
+ win32_getchar
+ win32_putchar
+ win32_malloc
+ win32_calloc
+ win32_realloc
+ win32_free
+ win32_sleep
+ win32_times
+ win32_access
+ win32_alarm
+ win32_chmod
+ win32_open_osfhandle
+ win32_get_osfhandle
+ win32_ioctl
+ win32_link
+ win32_unlink
+ win32_utime
+ win32_uname
+ win32_wait
+ win32_waitpid
+ win32_kill
+ win32_str_os_error
+ win32_opendir
+ win32_readdir
+ win32_telldir
+ win32_seekdir
+ win32_rewinddir
+ win32_closedir
+ win32_longpath
+ win32_os_id
+ win32_getpid
+ win32_crypt
+ win32_dynaload
+ ))
+ {
try_symbol($symbol);
}
}
elsif ($PLATFORM eq 'os2') {
- open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
- /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
- close MAP or die 'Cannot close miniperl.map';
-
- @missing = grep { !exists $mapped{$_} and !exists $bincompat5005{$_} }
- keys %export;
- delete $export{$_} foreach @missing;
+ open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
+ /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
+ close MAP or die 'Cannot close miniperl.map';
+
+ @missing = grep { !exists $mapped{$_} and !exists $bincompat5005{$_} }
+ keys %export;
+ delete $export{$_} foreach @missing;
}
# Now all symbols should be defined because
# next we are going to output them.
-foreach my $symbol (sort keys %export)
- {
- output_symbol($symbol);
- }
+foreach my $symbol (sort keys %export) {
+ output_symbol($symbol);
+}
sub emit_symbol {
- my $symbol = shift;
- chomp($symbol);
- $export{$symbol} = 1;
+ my $symbol = shift;
+ chomp($symbol);
+ $export{$symbol} = 1;
}
sub output_symbol {
# print "\t$symbol\n";
# print "\t_$symbol = $symbol\n";
# }
- } elsif ($PLATFORM eq 'os2') {
+ }
+ elsif ($PLATFORM eq 'os2') {
print qq( "$symbol"\n);
- } elsif ($PLATFORM eq 'aix') {
+ }
+ elsif ($PLATFORM eq 'aix') {
print "$symbol\n";
}
}
__DATA__
# extra globals not included above.
perl_alloc
+perl_alloc_using
+perl_clone
+perl_clone_using
perl_construct
perl_destruct
perl_free
-e 's|\\$||' \
-e p \
-e '}' ) >UU/$file.c
+ if [ "$osname" = os390 -a "$file" = perly.c ]; then
+ $echo '#endif' >>UU/$file.c
+ fi
$cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
$sed \
-e '/^#.*<stdin>/d' \
}
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) malloc %ld bytes\n",
- (unsigned long)(p+1), (unsigned long)(PL_an++),
+ "0x%"UVxf": (%05lu) malloc %ld bytes\n",
+ PTR2UV(p+1), (unsigned long)(PL_an++),
(long)size));
/* remove from linked list */
#if defined(RCHECK)
if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) {
dTHXo;
- PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
- (unsigned long)*((int*)p),(unsigned long)p);
+ PerlIO_printf(PerlIO_stderr(),
+ "Corrupt malloc ptr 0x%lx at 0x%"UVxf"\n",
+ (unsigned long)*((int*)p),PTR2UV(p));
}
#endif
nextf[bucket] = p->ov_next;
#endif
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) free\n",
- (unsigned long)cp, (unsigned long)(PL_an++)));
+ "0x%"UVxf": (%05lu) free\n",
+ PTR2UV(cp), (unsigned long)(PL_an++)));
if (cp == NULL)
return;
#endif
res = cp;
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) realloc %ld bytes inplace\n",
- (unsigned long)res,(unsigned long)(PL_an++),
+ "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n",
+ PTR2UV(res),(unsigned long)(PL_an++),
(long)size));
} else if (incr == 1 && (cp - M_OVERHEAD == last_op)
&& (onb > (1 << LOG_OF_MIN_ARENA))) {
} else {
hard_way:
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) realloc %ld bytes the hard way\n",
- (unsigned long)cp,(unsigned long)(PL_an++),
+ "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n",
+ PTR2UV(cp),(unsigned long)(PL_an++),
(long)size));
if ((res = (char*)Perl_malloc(nbytes)) == NULL)
return (NULL);
}
}
- DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
- size, reqsize, Perl_sbrk_oldsize, got));
+ 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;
}
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
if (vtbl) {
- if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP))
+ if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
SvGMAGICAL_on(sv);
if (vtbl->svt_set)
SvSMAGICAL_on(sv);
- if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL))
+ if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
SvRMAGICAL_on(sv);
}
}
mgp = &SvMAGIC(sv);
while ((mg = *mgp) != 0) {
MGVTBL* vtbl = mg->mg_virtual;
- if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) {
+ if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
/* Ignore this magic if it's been deleted */
if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
(SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
}
- if (vtbl && (vtbl->svt_set != NULL))
+ if (vtbl && vtbl->svt_set)
CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
}
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
- if (vtbl && (vtbl->svt_len != NULL)) {
+ if (vtbl && vtbl->svt_len) {
I32 mgs_ix;
mgs_ix = SSNEW(sizeof(MGS));
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
- if (vtbl && (vtbl->svt_len != NULL)) {
+ if (vtbl && vtbl->svt_len) {
I32 mgs_ix;
mgs_ix = SSNEW(sizeof(MGS));
MGVTBL* vtbl = mg->mg_virtual;
/* omit GSKIP -- never set here */
- if (vtbl && (vtbl->svt_clear != NULL))
+ if (vtbl && vtbl->svt_clear)
CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
}
for (mg = SvMAGIC(sv); mg; mg = moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
moremagic = mg->mg_moremagic;
- if (vtbl && (vtbl->svt_free != NULL))
+ if (vtbl && vtbl->svt_free)
CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
if (mg->mg_ptr && mg->mg_type != 'g')
if (mg->mg_len >= 0)
case '\004': /* ^D */
sv_setiv(sv, (IV)(PL_debug & 32767));
+#if defined(YYDEBUG) && defined(DEBUGGING)
+ PL_yydebug = (PL_debug & 1);
+#endif
break;
case '\005': /* ^E */
+#ifdef MACOS_TRADITIONAL
+ {
+ char msg[256];
+
+ sv_setnv(sv,(double)gLastMacOSErr);
+ sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : "");
+ }
+#else
#ifdef VMS
{
# include <descrip.h>
#endif
#endif
#endif
+#endif
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '\006': /* ^F */
break;
case '(':
sv_setiv(sv, (IV)PL_gid);
- Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_gid);
+#ifdef HAS_GETGROUPS
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
+#endif
goto add_groups;
case ')':
sv_setiv(sv, (IV)PL_egid);
- Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_egid);
+#ifdef HAS_GETGROUPS
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
+#endif
add_groups:
#ifdef HAS_GETGROUPS
{
Groups_t gary[NGROUPS];
i = getgroups(NGROUPS,gary);
while (--i >= 0)
- Perl_sv_catpvf(aTHX_ sv, " %Vd", (IV)gary[i]);
+ Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]);
}
#endif
SvIOK_on(sv); /* what a wonderful hack! */
break;
case '*':
break;
+#ifndef MACOS_TRADITIONAL
case '0':
break;
+#endif
#ifdef USE_THREADS
case '@':
sv_setsv(sv, thr->errsv);
#if defined(VMS)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
-# ifdef WIN32
+# ifdef PERL_IMPLICIT_SYS
+ PerlEnv_clearenv();
+# else
+# ifdef WIN32
char *envv = GetEnvironmentStrings();
char *cur = envv;
STRLEN len;
cur += len+1;
}
FreeEnvironmentStrings(envv);
-# else
-# ifdef CYGWIN
+# else
+# ifdef CYGWIN
I32 i;
for (i = 0; environ[i]; i++)
Safefree(environ[i]);
-# else
-# ifndef PERL_USE_SAFE_PUTENV
+# else
+# ifndef PERL_USE_SAFE_PUTENV
I32 i;
if (environ == PL_origenviron)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
-# endif /* PERL_USE_SAFE_PUTENV */
-# endif /* CYGWIN */
+# endif /* PERL_USE_SAFE_PUTENV */
+# endif /* CYGWIN */
environ[0] = Nullch;
-# endif /* WIN32 */
+# endif /* WIN32 */
+# endif /* PERL_IMPLICIT_SYS */
#endif /* VMS */
return 0;
}
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
dSP;
- char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+ const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
ENTER;
SAVETMPS;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
atoi(MgPV(mg,n_a)), FALSE);
- if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
+ if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp))))
o->op_private = i;
else if (ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL, "Can't break at that line\n");
DEBUG_x(dump_all());
break;
case '\005': /* ^E */
-#ifdef VMS
- set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#ifdef MACOS_TRADITIONAL
+ gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
#else
-# ifdef WIN32
- SetLastError( SvIV(sv) );
+# ifdef VMS
+ set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
# else
-# ifndef OS2
+# ifdef WIN32
+ SetLastError( SvIV(sv) );
+# else
+# ifndef OS2
/* will anyone ever use this? */
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+# endif
# endif
# endif
#endif
PL_dowarn |= G_WARN_ONCE ;
}
}
- }
+ }
break;
case '.':
if (PL_localizing) {
if (PL_localizing == 1)
- save_sptr((SV**)&PL_last_in_gv);
+ SAVESPTR(PL_last_in_gv);
}
else if (SvOK(sv) && GvIO(PL_last_in_gv))
IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv);
case '\\':
if (PL_ors)
Safefree(PL_ors);
- if (SvOK(sv) || SvGMAGICAL(sv))
- PL_ors = savepv(SvPV(sv,PL_orslen));
+ if (SvOK(sv) || SvGMAGICAL(sv)) {
+ s = SvPV(sv,PL_orslen);
+ PL_ors = savepvn(s,PL_orslen);
+ }
else {
PL_ors = Nullch;
PL_orslen = 0;
case ':':
PL_chopset = SvPV_force(sv,len);
break;
+#ifndef MACOS_TRADITIONAL
case '0':
if (!PL_origalen) {
s = PL_origargv[0];
PL_origargv[i] = Nullch;
}
break;
+#endif
#ifdef USE_THREADS
case '@':
sv_setsv(thr->errsv, sv);
Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
{
dTHR;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: magic_mutexfree 0x%lx\n",
- (unsigned long)thr, (unsigned long)sv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
if (MgOWNER(mg))
Perl_croak(aTHX_ "panic: magic_mutexfree");
MUTEX_DESTROY(MgMUTEXP(mg));
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
#define PL_LIO (*Perl_ILIO_ptr(aTHXo))
#undef PL_Mem
#define PL_Mem (*Perl_IMem_ptr(aTHXo))
+#undef PL_MemParse
+#define PL_MemParse (*Perl_IMemParse_ptr(aTHXo))
+#undef PL_MemShared
+#define PL_MemShared (*Perl_IMemShared_ptr(aTHXo))
#undef PL_Proc
#define PL_Proc (*Perl_IProc_ptr(aTHXo))
#undef PL_Sock
#define PL_StdIO (*Perl_IStdIO_ptr(aTHXo))
#undef PL_amagic_generation
#define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo))
-#undef PL_ampergv
-#define PL_ampergv (*Perl_Iampergv_ptr(aTHXo))
#undef PL_an
#define PL_an (*Perl_Ian_ptr(aTHXo))
#undef PL_archpat_auto
#define PL_archpat_auto (*Perl_Iarchpat_auto_ptr(aTHXo))
#undef PL_argvgv
#define PL_argvgv (*Perl_Iargvgv_ptr(aTHXo))
+#undef PL_argvout_stack
+#define PL_argvout_stack (*Perl_Iargvout_stack_ptr(aTHXo))
#undef PL_argvoutgv
#define PL_argvoutgv (*Perl_Iargvoutgv_ptr(aTHXo))
#undef PL_basetime
#define PL_bufend (*Perl_Ibufend_ptr(aTHXo))
#undef PL_bufptr
#define PL_bufptr (*Perl_Ibufptr_ptr(aTHXo))
-#undef PL_cddir
-#define PL_cddir (*Perl_Icddir_ptr(aTHXo))
#undef PL_collation_ix
#define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHXo))
#undef PL_collation_name
#define PL_curthr (*Perl_Icurthr_ptr(aTHXo))
#undef PL_dbargs
#define PL_dbargs (*Perl_Idbargs_ptr(aTHXo))
-#undef PL_debdelim
-#define PL_debdelim (*Perl_Idebdelim_ptr(aTHXo))
-#undef PL_debname
-#define PL_debname (*Perl_Idebname_ptr(aTHXo))
#undef PL_debstash
#define PL_debstash (*Perl_Idebstash_ptr(aTHXo))
#undef PL_debug
#define PL_defgv (*Perl_Idefgv_ptr(aTHXo))
#undef PL_diehook
#define PL_diehook (*Perl_Idiehook_ptr(aTHXo))
-#undef PL_dlevel
-#define PL_dlevel (*Perl_Idlevel_ptr(aTHXo))
-#undef PL_dlmax
-#define PL_dlmax (*Perl_Idlmax_ptr(aTHXo))
#undef PL_doextract
#define PL_doextract (*Perl_Idoextract_ptr(aTHXo))
#undef PL_doswitches
#define PL_eval_start (*Perl_Ieval_start_ptr(aTHXo))
#undef PL_evalseq
#define PL_evalseq (*Perl_Ievalseq_ptr(aTHXo))
+#undef PL_exit_flags
+#define PL_exit_flags (*Perl_Iexit_flags_ptr(aTHXo))
#undef PL_exitlist
#define PL_exitlist (*Perl_Iexitlist_ptr(aTHXo))
#undef PL_exitlistlen
#define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo))
#undef PL_filemode
#define PL_filemode (*Perl_Ifilemode_ptr(aTHXo))
-#undef PL_filter_debug
-#define PL_filter_debug (*Perl_Ifilter_debug_ptr(aTHXo))
#undef PL_forkprocess
#define PL_forkprocess (*Perl_Iforkprocess_ptr(aTHXo))
#undef PL_formfeed
#define PL_last_uni (*Perl_Ilast_uni_ptr(aTHXo))
#undef PL_lastfd
#define PL_lastfd (*Perl_Ilastfd_ptr(aTHXo))
-#undef PL_lastsize
-#define PL_lastsize (*Perl_Ilastsize_ptr(aTHXo))
-#undef PL_lastspbase
-#define PL_lastspbase (*Perl_Ilastspbase_ptr(aTHXo))
#undef PL_laststatval
#define PL_laststatval (*Perl_Ilaststatval_ptr(aTHXo))
#undef PL_laststype
#define PL_laststype (*Perl_Ilaststype_ptr(aTHXo))
-#undef PL_leftgv
-#define PL_leftgv (*Perl_Ileftgv_ptr(aTHXo))
#undef PL_lex_brackets
#define PL_lex_brackets (*Perl_Ilex_brackets_ptr(aTHXo))
#undef PL_lex_brackstack
#define PL_lex_dojoin (*Perl_Ilex_dojoin_ptr(aTHXo))
#undef PL_lex_expect
#define PL_lex_expect (*Perl_Ilex_expect_ptr(aTHXo))
-#undef PL_lex_fakebrack
-#define PL_lex_fakebrack (*Perl_Ilex_fakebrack_ptr(aTHXo))
#undef PL_lex_formbrack
#define PL_lex_formbrack (*Perl_Ilex_formbrack_ptr(aTHXo))
#undef PL_lex_inpat
#define PL_multi_start (*Perl_Imulti_start_ptr(aTHXo))
#undef PL_multiline
#define PL_multiline (*Perl_Imultiline_ptr(aTHXo))
-#undef PL_mystrk
-#define PL_mystrk (*Perl_Imystrk_ptr(aTHXo))
#undef PL_nexttoke
#define PL_nexttoke (*Perl_Inexttoke_ptr(aTHXo))
#undef PL_nexttype
#define PL_ofmt (*Perl_Iofmt_ptr(aTHXo))
#undef PL_oldbufptr
#define PL_oldbufptr (*Perl_Ioldbufptr_ptr(aTHXo))
-#undef PL_oldlastpm
-#define PL_oldlastpm (*Perl_Ioldlastpm_ptr(aTHXo))
#undef PL_oldname
#define PL_oldname (*Perl_Ioldname_ptr(aTHXo))
#undef PL_oldoldbufptr
#define PL_preprocess (*Perl_Ipreprocess_ptr(aTHXo))
#undef PL_profiledata
#define PL_profiledata (*Perl_Iprofiledata_ptr(aTHXo))
+#undef PL_psig_name
+#define PL_psig_name (*Perl_Ipsig_name_ptr(aTHXo))
+#undef PL_psig_ptr
+#define PL_psig_ptr (*Perl_Ipsig_ptr_ptr(aTHXo))
+#undef PL_ptr_table
+#define PL_ptr_table (*Perl_Iptr_table_ptr(aTHXo))
#undef PL_replgv
#define PL_replgv (*Perl_Ireplgv_ptr(aTHXo))
-#undef PL_rightgv
-#define PL_rightgv (*Perl_Irightgv_ptr(aTHXo))
#undef PL_rsfp
#define PL_rsfp (*Perl_Irsfp_ptr(aTHXo))
#undef PL_rsfp_filters
#define PL_runops (*Perl_Irunops_ptr(aTHXo))
#undef PL_sawampersand
#define PL_sawampersand (*Perl_Isawampersand_ptr(aTHXo))
-#undef PL_sawstudy
-#define PL_sawstudy (*Perl_Isawstudy_ptr(aTHXo))
-#undef PL_sawvec
-#define PL_sawvec (*Perl_Isawvec_ptr(aTHXo))
#undef PL_sh_path
#define PL_sh_path (*Perl_Ish_path_ptr(aTHXo))
-#undef PL_siggv
-#define PL_siggv (*Perl_Isiggv_ptr(aTHXo))
#undef PL_sighandlerp
#define PL_sighandlerp (*Perl_Isighandlerp_ptr(aTHXo))
#undef PL_splitstr
#define PL_stderrgv (*Perl_Istderrgv_ptr(aTHXo))
#undef PL_stdingv
#define PL_stdingv (*Perl_Istdingv_ptr(aTHXo))
-#undef PL_strchop
-#define PL_strchop (*Perl_Istrchop_ptr(aTHXo))
+#undef PL_stopav
+#define PL_stopav (*Perl_Istopav_ptr(aTHXo))
#undef PL_strtab
#define PL_strtab (*Perl_Istrtab_ptr(aTHXo))
#undef PL_strtab_mutex
#define PL_sys_intern (*Perl_Isys_intern_ptr(aTHXo))
#undef PL_tainting
#define PL_tainting (*Perl_Itainting_ptr(aTHXo))
-#undef PL_thisexpr
-#define PL_thisexpr (*Perl_Ithisexpr_ptr(aTHXo))
#undef PL_thr_key
#define PL_thr_key (*Perl_Ithr_key_ptr(aTHXo))
#undef PL_threadnum
/* XXX soon to be eliminated, only a few things in PERLCORE need these now */
+#if defined(PERL_IMPLICIT_SYS)
+#else
+#endif
+#if defined(USE_ITHREADS)
+# if defined(PERL_IMPLICIT_SYS)
+# endif
+#endif
+#if defined(MYMALLOC)
+#endif
#if defined(PERL_OBJECT)
#endif
+#if defined(PERL_OBJECT)
+#else
+#endif
#undef Perl_amagic_call
#define Perl_amagic_call pPerl->Perl_amagic_call
#undef amagic_call
#define Perl_vdeb pPerl->Perl_vdeb
#undef vdeb
#define vdeb Perl_vdeb
-#undef Perl_deb_growlevel
-#define Perl_deb_growlevel pPerl->Perl_deb_growlevel
-#undef deb_growlevel
-#define deb_growlevel Perl_deb_growlevel
#undef Perl_debprofdump
#define Perl_debprofdump pPerl->Perl_debprofdump
#undef debprofdump
#define Perl_magicname pPerl->Perl_magicname
#undef magicname
#define magicname Perl_magicname
-#if defined(MYMALLOC)
-#undef Perl_malloced_size
-#define Perl_malloced_size pPerl->Perl_malloced_size
-#undef malloced_size
-#define malloced_size Perl_malloced_size
-#endif
#undef Perl_markstack_grow
#define Perl_markstack_grow pPerl->Perl_markstack_grow
#undef markstack_grow
#define Perl_newLISTOP pPerl->Perl_newLISTOP
#undef newLISTOP
#define newLISTOP Perl_newLISTOP
+#undef Perl_newPADOP
+#define Perl_newPADOP pPerl->Perl_newPADOP
+#undef newPADOP
+#define newPADOP Perl_newPADOP
#undef Perl_newPMOP
#define Perl_newPMOP pPerl->Perl_newPMOP
#undef newPMOP
#undef peep
#define peep Perl_peep
#if defined(PERL_OBJECT)
-#undef perl_construct
-#define perl_construct pPerl->perl_construct
-#undef perl_destruct
-#define perl_destruct pPerl->perl_destruct
-#undef perl_free
-#define perl_free pPerl->perl_free
-#undef perl_run
-#define perl_run pPerl->perl_run
-#undef perl_parse
-#define perl_parse pPerl->perl_parse
-#else
-#undef perl_alloc
-#define perl_alloc pPerl->perl_alloc
-#undef perl_construct
-#define perl_construct pPerl->perl_construct
-#undef perl_destruct
-#define perl_destruct pPerl->perl_destruct
-#undef perl_free
-#define perl_free pPerl->perl_free
-#undef perl_run
-#define perl_run pPerl->perl_run
-#undef perl_parse
-#define perl_parse pPerl->perl_parse
+#undef Perl_construct
+#define Perl_construct pPerl->Perl_construct
+#undef Perl_destruct
+#define Perl_destruct pPerl->Perl_destruct
+#undef Perl_free
+#define Perl_free pPerl->Perl_free
+#undef Perl_run
+#define Perl_run pPerl->Perl_run
+#undef Perl_parse
+#define Perl_parse pPerl->Perl_parse
+#endif
#if defined(USE_THREADS)
#undef Perl_new_struct_thread
#define Perl_new_struct_thread pPerl->Perl_new_struct_thread
#undef new_struct_thread
#define new_struct_thread Perl_new_struct_thread
#endif
-#endif
#undef Perl_call_atexit
#define Perl_call_atexit pPerl->Perl_call_atexit
#undef call_atexit
#define Perl_save_I32 pPerl->Perl_save_I32
#undef save_I32
#define save_I32 Perl_save_I32
+#undef Perl_save_I8
+#define Perl_save_I8 pPerl->Perl_save_I8
+#undef save_I8
+#define save_I8 Perl_save_I8
#undef Perl_save_int
#define Perl_save_int pPerl->Perl_save_int
#undef save_int
#define Perl_save_pptr pPerl->Perl_save_pptr
#undef save_pptr
#define save_pptr Perl_save_pptr
+#undef Perl_save_vptr
+#define Perl_save_vptr pPerl->Perl_save_vptr
+#undef save_vptr
+#define save_vptr Perl_save_vptr
#undef Perl_save_re_context
#define Perl_save_re_context pPerl->Perl_save_re_context
#undef save_re_context
#define Perl_wait4pid pPerl->Perl_wait4pid
#undef wait4pid
#define wait4pid Perl_wait4pid
+#undef Perl_report_uninit
+#define Perl_report_uninit pPerl->Perl_report_uninit
+#undef report_uninit
+#define report_uninit Perl_report_uninit
#undef Perl_warn
#define Perl_warn pPerl->Perl_warn
#undef warn
#define Perl_dump_mstats pPerl->Perl_dump_mstats
#undef dump_mstats
#define dump_mstats Perl_dump_mstats
-#undef Perl_malloc
-#define Perl_malloc pPerl->Perl_malloc
-#undef malloc
-#define malloc Perl_malloc
-#undef Perl_calloc
-#define Perl_calloc pPerl->Perl_calloc
-#undef calloc
-#define calloc Perl_calloc
-#undef Perl_realloc
-#define Perl_realloc pPerl->Perl_realloc
-#undef realloc
-#define realloc Perl_realloc
-#undef Perl_mfree
-#define Perl_mfree pPerl->Perl_mfree
-#undef mfree
-#define mfree Perl_mfree
#endif
#undef Perl_safesysmalloc
#define Perl_safesysmalloc pPerl->Perl_safesysmalloc
#define Perl_boot_core_xsutils pPerl->Perl_boot_core_xsutils
#undef boot_core_xsutils
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#undef Perl_cx_dup
+#define Perl_cx_dup pPerl->Perl_cx_dup
+#undef cx_dup
+#define cx_dup Perl_cx_dup
+#undef Perl_si_dup
+#define Perl_si_dup pPerl->Perl_si_dup
+#undef si_dup
+#define si_dup Perl_si_dup
+#undef Perl_ss_dup
+#define Perl_ss_dup pPerl->Perl_ss_dup
+#undef ss_dup
+#define ss_dup Perl_ss_dup
+#undef Perl_any_dup
+#define Perl_any_dup pPerl->Perl_any_dup
+#undef any_dup
+#define any_dup Perl_any_dup
+#undef Perl_he_dup
+#define Perl_he_dup pPerl->Perl_he_dup
+#undef he_dup
+#define he_dup Perl_he_dup
+#undef Perl_re_dup
+#define Perl_re_dup pPerl->Perl_re_dup
+#undef re_dup
+#define re_dup Perl_re_dup
+#undef Perl_fp_dup
+#define Perl_fp_dup pPerl->Perl_fp_dup
+#undef fp_dup
+#define fp_dup Perl_fp_dup
+#undef Perl_dirp_dup
+#define Perl_dirp_dup pPerl->Perl_dirp_dup
+#undef dirp_dup
+#define dirp_dup Perl_dirp_dup
+#undef Perl_gp_dup
+#define Perl_gp_dup pPerl->Perl_gp_dup
+#undef gp_dup
+#define gp_dup Perl_gp_dup
+#undef Perl_mg_dup
+#define Perl_mg_dup pPerl->Perl_mg_dup
+#undef mg_dup
+#define mg_dup Perl_mg_dup
+#undef Perl_sv_dup
+#define Perl_sv_dup pPerl->Perl_sv_dup
+#undef sv_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#undef Perl_sys_intern_dup
+#define Perl_sys_intern_dup pPerl->Perl_sys_intern_dup
+#undef sys_intern_dup
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#undef Perl_ptr_table_new
+#define Perl_ptr_table_new pPerl->Perl_ptr_table_new
+#undef ptr_table_new
+#define ptr_table_new Perl_ptr_table_new
+#undef Perl_ptr_table_fetch
+#define Perl_ptr_table_fetch pPerl->Perl_ptr_table_fetch
+#undef ptr_table_fetch
+#define ptr_table_fetch Perl_ptr_table_fetch
+#undef Perl_ptr_table_store
+#define Perl_ptr_table_store pPerl->Perl_ptr_table_store
+#undef ptr_table_store
+#define ptr_table_store Perl_ptr_table_store
+#undef Perl_ptr_table_split
+#define Perl_ptr_table_split pPerl->Perl_ptr_table_split
+#undef ptr_table_split
+#define ptr_table_split Perl_ptr_table_split
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
#endif
# if defined(LEAKTEST)
# endif
#endif
+#if defined(PERL_OBJECT)
+#endif
#undef Perl_ck_anoncode
#define Perl_ck_anoncode pPerl->Perl_ck_anoncode
#undef ck_anoncode
#include "keywords.h"
/* #define PL_OP_SLAB_ALLOC */
-
+
+/* XXXXXX testing */
+#ifdef USE_ITHREADS
+# define OP_REFCNT_LOCK NOOP
+# define OP_REFCNT_UNLOCK NOOP
+# define OpREFCNT_set(o,n) ((o)->op_targ = (n))
+# define OpREFCNT_dec(o) (--(o)->op_targ)
+#else
+# define OP_REFCNT_LOCK NOOP
+# define OP_REFCNT_UNLOCK NOOP
+# define OpREFCNT_set(o,n) NOOP
+# define OpREFCNT_dec(o) 0
+#endif
+
#ifdef PL_OP_SLAB_ALLOC
#define SLAB_SIZE 8192
static char *PL_OpPtr = NULL;
{
qerror(Perl_mess(aTHX_
"Bareword \"%s\" not allowed while \"strict subs\" in use",
- SvPV_nolen(cSVOPo->op_sv)));
+ SvPV_nolen(cSVOPo_sv)));
}
/* "register" allocation */
return 0;
}
break;
+ case CXt_FORMAT:
case CXt_SUB:
if (!saweval)
return 0;
(sv = names[PL_padix]) && sv != &PL_sv_undef)
continue;
sv = *av_fetch(PL_comppad, PL_padix, TRUE);
- if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
+ if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv))
break;
}
retval = PL_padix;
SvFLAGS(sv) |= tmptype;
PL_curpad = AvARRAY(PL_comppad);
#ifdef USE_THREADS
- DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
- (unsigned long) thr, (unsigned long) PL_curpad,
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
+ PTR2UV(thr), PTR2UV(PL_curpad),
(long) retval, PL_op_name[optype]));
#else
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
- (unsigned long) PL_curpad,
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "Pad 0x%"UVxf" alloc %ld for %s\n",
+ PTR2UV(PL_curpad),
(long) retval, PL_op_name[optype]));
#endif /* USE_THREADS */
return (PADOFFSET)retval;
{
dTHR;
#ifdef USE_THREADS
- DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
- (unsigned long) thr, (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
#else
if (!po)
Perl_croak(aTHX_ "panic: pad_sv po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
- (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
return PL_curpad[po]; /* eventually we'll turn this into a macro */
}
if (!po)
Perl_croak(aTHX_ "panic: pad_free po");
#ifdef USE_THREADS
- DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
- (unsigned long) thr, (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
#else
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
- (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
SvPADTMP_off(PL_curpad[po]);
if (!po)
Perl_croak(aTHX_ "panic: pad_swipe po");
#ifdef USE_THREADS
- DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
- (unsigned long) thr, (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
#else
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
- (unsigned long) PL_curpad, po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
SvPADTMP_off(PL_curpad[po]);
PL_curpad[po] = NEWSV(1107,0);
if (AvARRAY(PL_comppad) != PL_curpad)
Perl_croak(aTHX_ "panic: pad_reset curpad");
#ifdef USE_THREADS
- DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
- (unsigned long) thr, (unsigned long) PL_curpad));
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" Pad 0x%"UVxf" reset\n",
+ PTR2UV(thr), PTR2UV(PL_curpad)));
#else
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
- (unsigned long) PL_curpad));
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
+ PTR2UV(PL_curpad)));
#endif /* USE_THREADS */
if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
if (!o || o->op_seq == (U16)-1)
return;
+ if (o->op_private & OPpREFCOUNTED) {
+ switch (o->op_type) {
+ case OP_LEAVESUB:
+ case OP_LEAVESUBLV:
+ case OP_LEAVEEVAL:
+ case OP_LEAVE:
+ case OP_SCOPE:
+ case OP_LEAVEWRITE:
+ OP_REFCNT_LOCK;
+ if (OpREFCNT_dec(o)) {
+ OP_REFCNT_UNLOCK;
+ return;
+ }
+ OP_REFCNT_UNLOCK;
+ break;
+ default:
+ break;
+ }
+ }
+
if (o->op_flags & OPf_KIDS) {
for (kid = cUNOPo->op_first; kid; kid = nextkid) {
nextkid = kid->op_sibling; /* Get before next freeing kid */
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
- SvREFCNT_dec(cGVOPo->op_gv);
- cGVOPo->op_gv = Nullgv;
+#ifdef USE_ITHREADS
+ if (cPADOPo->op_padix > 0) {
+ if (PL_curpad) {
+ GV *gv = cGVOPo_gv;
+ pad_swipe(cPADOPo->op_padix);
+ /* No GvIN_PAD_off(gv) here, because other references may still
+ * exist on the pad */
+ SvREFCNT_dec(gv);
+ }
+ cPADOPo->op_padix = 0;
+ }
+#else
+ SvREFCNT_dec(cSVOPo->op_sv);
+ cSVOPo->op_sv = Nullsv;
+#endif
break;
case OP_CONST:
SvREFCNT_dec(cSVOPo->op_sv);
break;
case OP_SUBST:
op_free(cPMOPo->op_pmreplroot);
- cPMOPo->op_pmreplroot = Nullop;
- /* FALL THROUGH */
+ goto clear_pmop;
case OP_PUSHRE:
+#ifdef USE_ITHREADS
+ if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+ if (PL_curpad) {
+ GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
+ pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+ /* No GvIN_PAD_off(gv) here, because other references may still
+ * exist on the pad */
+ SvREFCNT_dec(gv);
+ }
+ }
+#else
+ SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+#endif
+ /* FALL THROUGH */
case OP_MATCH:
case OP_QR:
+clear_pmop:
+ cPMOPo->op_pmreplroot = Nullop;
ReREFCNT_dec(cPMOPo->op_pmregexp);
cPMOPo->op_pmregexp = (REGEXP*)NULL;
break;
}
- if (o->op_targ > 0)
+ if (o->op_targ > 0) {
pad_free(o->op_targ);
+ o->op_targ = 0;
+ }
}
STATIC void
S_cop_free(pTHX_ COP* cop)
{
Safefree(cop->cop_label);
- SvREFCNT_dec(cop->cop_filegv);
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */
+ Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */
+#else
+ /* NOTE: COP.cop_stash is not refcounted */
+ SvREFCNT_dec(CopFILEGV(cop));
+#endif
if (! specialWARN(cop->cop_warnings))
SvREFCNT_dec(cop->cop_warnings);
}
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
dTHR;
if (ckWARN(WARN_SYNTAX)) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
return scalar(o);
/* assumes no premature commitment */
if (!o || (o->op_flags & OPf_WANT) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
- if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
- return scalar(o); /* As if inside SASSIGN */
-
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
switch (o->op_type) {
want = o->op_flags & OPf_WANT;
if ((want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return scalar(o); /* As if inside SASSIGN */
+ }
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
break;
case OP_CONST:
- sv = cSVOPo->op_sv;
+ sv = cSVOPo_sv;
if (cSVOPo->op_private & OPpCONST_STRICT)
no_bareword_allowed(o);
else {
/* assumes no premature commitment */
if (!o || (o->op_flags & OPf_WANT) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return o; /* As if inside SASSIGN */
+ }
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
return o;
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return o;
+ }
switch (o->op_type) {
case OP_UNDEF:
if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
- PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
+ PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
PL_eval_start = 0;
}
else if (!type) {
}
else { /* lvalue subroutine call */
o->op_private |= OPpLVAL_INTRO;
- if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+ if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
/* Backward compatibility mode: */
o->op_private |= OPpENTERSUB_INARGS;
break;
break;
}
- cv = GvCV(kGVOP->op_gv);
+ cv = GvCV(kGVOP_gv);
if (!cv)
goto restore_2cv;
if (CvLVALUE(cv))
char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
right->op_type == OP_TRANS)
? right->op_type : OP_MATCH];
- char *sample = ((left->op_type == OP_RV2AV ||
- left->op_type == OP_PADAV)
- ? "@array" : "%hash");
+ const char *sample = ((left->op_type == OP_RV2AV ||
+ left->op_type == OP_PADAV)
+ ? "@array" : "%hash");
Perl_warner(aTHX_ WARN_UNSAFE,
"Applying %s to %s will act on scalar(%s)",
desc, sample, sample);
PL_pad_reset_pending = FALSE;
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
- SAVEPPTR(PL_compiling.cop_warnings);
+ SAVESPTR(PL_compiling.cop_warnings);
if (! specialWARN(PL_compiling.cop_warnings)) {
PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
SAVEFREESV(PL_compiling.cop_warnings) ;
((PL_in_eval & EVAL_KEEPERR)
? OPf_SPECIAL : 0), o);
PL_eval_start = linklist(PL_eval_root);
+ PL_eval_root->op_private |= OPpREFCOUNTED;
+ OpREFCNT_set(PL_eval_root, 1);
PL_eval_root->op_next = 0;
peep(PL_eval_start);
}
PL_main_root = scope(sawparens(scalarvoid(o)));
PL_curcop = &PL_compiling;
PL_main_start = LINKLIST(PL_main_root);
+ PL_main_root->op_private |= OPpREFCOUNTED;
+ OpREFCNT_set(PL_main_root, 1);
PL_main_root->op_next = 0;
peep(PL_main_start);
PL_compcv = 0;
if (cv) {
dSP;
PUSHMARK(SP);
- XPUSHs((SV*)PL_compiling.cop_filegv);
+ XPUSHs((SV*)CopFILEGV(&PL_compiling));
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
}
OP *curop;
if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
- if (PL_curcop->cop_line < PL_multi_end)
- PL_curcop->cop_line = PL_multi_end;
+ if (CopLINE(PL_curcop) < PL_multi_end)
+ CopLINE_set(PL_curcop, PL_multi_end);
}
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
}
#else
if (curop->op_type == OP_GV) {
- GV *gv = ((GVOP*)curop)->op_gv;
+ GV *gv = cGVOPx_gv(curop);
repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
OP *
+Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
+{
+ PADOP *padop;
+ NewOp(1101, padop, 1, PADOP);
+ padop->op_type = type;
+ padop->op_ppaddr = PL_ppaddr[type];
+ padop->op_padix = pad_alloc(type, SVs_PADTMP);
+ SvREFCNT_dec(PL_curpad[padop->op_padix]);
+ PL_curpad[padop->op_padix] = sv;
+ SvPADTMP_on(sv);
+ padop->op_next = (OP*)padop;
+ padop->op_flags = flags;
+ if (PL_opargs[type] & OA_RETSCALAR)
+ scalar((OP*)padop);
+ if (PL_opargs[type] & OA_TARGET)
+ padop->op_targ = pad_alloc(type, SVs_PADTMP);
+ return CHECKOP(type, padop);
+}
+
+OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
dTHR;
- GVOP *gvop;
- NewOp(1101, gvop, 1, GVOP);
- gvop->op_type = type;
- gvop->op_ppaddr = PL_ppaddr[type];
- gvop->op_gv = (GV*)SvREFCNT_inc(gv);
- gvop->op_next = (OP*)gvop;
- gvop->op_flags = flags;
- if (PL_opargs[type] & OA_RETSCALAR)
- scalar((OP*)gvop);
- if (PL_opargs[type] & OA_TARGET)
- gvop->op_targ = pad_alloc(type, SVs_PADTMP);
- return CHECKOP(type, gvop);
+#ifdef USE_ITHREADS
+ GvIN_PAD_on(gv);
+ return newPADOP(type, flags, SvREFCNT_inc(gv));
+#else
+ return newSVOP(type, flags, SvREFCNT_inc(gv));
+#endif
}
OP *
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV) {
- GV *gv = ((GVOP*)curop)->op_gv;
+ GV *gv = cGVOPx_gv(curop);
if (gv == PL_defgv || SvCUR(gv) == PL_generation)
break;
SvCUR(gv) = PL_generation;
{
tmpop = ((UNOP*)left)->op_first;
if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
- pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
+#ifdef USE_ITHREADS
+ pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+ cPADOPx(tmpop)->op_padix = 0; /* steal it */
+#else
+ pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+ cSVOPx(tmpop)->op_sv = Nullsv; /* steal it */
+#endif
pm->op_pmflags |= PMf_ONCE;
tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
register COP *cop;
NewOp(1101, cop, 1, COP);
- if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
+ if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
cop->op_type = OP_DBSTATE;
cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
}
if (PL_copline == NOLINE)
- cop->cop_line = PL_curcop->cop_line;
+ CopLINE_set(cop, CopLINE(PL_curcop));
else {
- cop->cop_line = PL_copline;
+ CopLINE_set(cop, PL_copline);
PL_copline = NOLINE;
}
- cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
- cop->cop_stash = PL_curstash;
+#ifdef USE_ITHREADS
+ CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */
+#else
+ CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
+#endif
+ CopSTASH_set(cop, PL_curstash);
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+ SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
(void)SvIOK_on(*svp);
- SvIVX(*svp) = 1;
- SvSTASH(*svp) = (HV*)cop;
+ SvIVX(*svp) = PTR2IV(cop);
}
}
break;
}
if (warnop) {
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ line_t oldline = CopLINE(PL_curcop);
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_UNSAFE,
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
? " construct" : "() operator"));
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
}
else if (sv->op_type == OP_PADSV) { /* private variable */
padoff = sv->op_targ;
+ sv->op_targ = 0;
op_free(sv);
sv = Nullop;
}
else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
padoff = sv->op_targ;
+ sv->op_targ = 0;
iterflags |= OPf_SPECIAL;
op_free(sv);
sv = Nullop;
#endif /* USE_THREADS */
ENTER;
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = 0;
if (!CvCLONED(cv))
}
}
-#ifdef DEBUG_CLOSURES
STATIC void
-cv_dump(CV *cv)
+S_cv_dump(pTHX_ CV *cv)
{
+#ifdef DEBUGGING
CV *outside = CvOUTSIDE(cv);
AV* padlist = CvPADLIST(cv);
AV* pad_name;
SV** ppad;
I32 ix;
- PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
- cv,
+ PerlIO_printf(Perl_debug_log,
+ "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
+ PTR2UV(cv),
(CvANON(cv) ? "ANON"
: (cv == PL_main_cv) ? "MAIN"
: CvUNIQUE(cv) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
- outside,
+ PTR2UV(outside),
(!outside ? "null"
: CvANON(outside) ? "ANON"
: (outside == PL_main_cv) ? "MAIN"
for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
if (SvPOK(pname[ix]))
- PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
- ix, ppad[ix],
+ PerlIO_printf(Perl_debug_log,
+ "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
+ ix, PTR2UV(ppad[ix]),
SvFAKE(pname[ix]) ? "FAKE " : "",
SvPVX(pname[ix]),
- (long)I_32(SvNVX(pname[ix])),
- (long)SvIVX(pname[ix]));
+ (IV)I_32(SvNVX(pname[ix])),
+ SvIVX(pname[ix]));
}
+#endif /* DEBUGGING */
}
-#endif /* DEBUG_CLOSURES */
STATIC CV *
S_cv_clone2(pTHX_ CV *proto, CV *outside)
assert(!CvUNIQUE(proto));
ENTER;
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
SAVESPTR(PL_comppad);
SAVESPTR(PL_comppad_name);
SAVESPTR(PL_compcv);
MUTEX_INIT(CvMUTEXP(cv));
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
- CvFILEGV(cv) = CvFILEGV(proto);
+ CvFILE(cv) = CvFILE(proto);
CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
CvSTASH(cv) = CvSTASH(proto);
CvROOT(cv) = CvROOT(proto);
PL_curpad[ix] = sv;
}
}
+ else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+ PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+ }
else {
SV* sv = NEWSV(0,0);
SvPADTMP_on(sv);
break;
if (sv)
return Nullsv;
- if (type == OP_CONST)
+ if (type == OP_CONST && cSVOPo->op_sv)
sv = cSVOPo->op_sv;
- else if (type == OP_PADSV && cv) {
+ else if ((type == OP_PADSV || type == OP_CONST) && cv) {
AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse"))) {
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ line_t oldline = CopLINE(PL_curcop);
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE,
const_sv ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
cv = Nullcv;
}
}
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(cv) = PL_curcop->cop_filegv;
+ CvFILE(cv) = CopFILE(PL_curcop);
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
+ if (CvLVALUE(cv)) {
+ CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
+ }
+ else {
+ CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+ }
+ CvROOT(cv)->op_private |= OPpREFCOUNTED;
+ OpREFCNT_set(CvROOT(cv), 1);
+ CvSTART(cv) = LINKLIST(CvROOT(cv));
+ CvROOT(cv)->op_next = 0;
+ peep(CvSTART(cv));
+
+ /* now that optimizer has done its work, adjust pad values */
if (CvCLONE(cv)) {
SV **namep = AvARRAY(PL_comppad_name);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
- if (SvIMMORTAL(PL_curpad[ix]))
+ if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
continue;
/*
* The only things that a clonable function needs in its
AvFLAGS(av) = AVf_REIFY;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
- if (SvIMMORTAL(PL_curpad[ix]))
+ if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
continue;
if (!SvPADMY(PL_curpad[ix]))
SvPADTMP_on(PL_curpad[ix]);
}
}
- if(CvLVALUE(cv)) {
- CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
- }
- else {
- CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
- }
- CvSTART(cv) = LINKLIST(CvROOT(cv));
- CvROOT(cv)->op_next = 0;
- peep(CvSTART(cv));
-
if (name) {
char *s;
CV *cv;
HV *hv;
- Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
- GvSV(PL_curcop->cop_filegv),
- (long)PL_subline, (long)PL_curcop->cop_line);
+ Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+ CopFILE(PL_curcop),
+ (long)PL_subline, (long)CopLINE(PL_curcop));
gv_efullname3(tmpstr, gv, Nullch);
hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
hv = GvHVn(db_postponed);
s++;
else
s = name;
+
+ if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+ goto done;
+
if (strEQ(s, "BEGIN")) {
I32 oldscope = PL_scopestack_ix;
ENTER;
- SAVESPTR(PL_compiling.cop_filegv);
- SAVEI16(PL_compiling.cop_line);
+ SAVECOPFILE(&PL_compiling);
+ SAVECOPLINE(&PL_compiling);
save_svref(&PL_rs);
sv_setsv(PL_rs, PL_nrs);
if (!PL_beginav)
PL_beginav = newAV();
DEBUG_x( dump_sub(gv) );
- av_push(PL_beginav, (SV *)cv);
+ av_push(PL_beginav, SvREFCNT_inc(cv));
GvCV(gv) = 0;
call_list(oldscope, PL_beginav);
else if (strEQ(s, "END") && !PL_error_count) {
if (!PL_endav)
PL_endav = newAV();
+ DEBUG_x( dump_sub(gv) );
av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, (SV *)cv);
+ av_store(PL_endav, 0, SvREFCNT_inc(cv));
+ GvCV(gv) = 0;
+ }
+ else if (strEQ(s, "STOP") && !PL_error_count) {
+ if (!PL_stopav)
+ PL_stopav = newAV();
+ DEBUG_x( dump_sub(gv) );
+ av_unshift(PL_stopav, 1);
+ av_store(PL_stopav, 0, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
else if (strEQ(s, "INIT") && !PL_error_count) {
if (!PL_initav)
PL_initav = newAV();
+ DEBUG_x( dump_sub(gv) );
av_push(PL_initav, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
{
dTHR;
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ ENTER;
+ SAVECOPLINE(PL_curcop);
+ SAVEHINTS();
+
+ CopLINE_set(PL_curcop, PL_copline);
PL_hints &= ~HINT_BLOCK_SCOPE;
- if(stash)
- PL_curstash = PL_curcop->cop_stash = stash;
+
+ if (stash) {
+ SAVESPTR(PL_curstash);
+ SAVECOPSTASH(PL_curcop);
+ PL_curstash = stash;
+#ifdef USE_ITHREADS
+ CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
+#else
+ CopSTASH(PL_curcop) = stash;
+#endif
+ }
newATTRSUB(
start_subparse(FALSE, 0),
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
+ LEAVE;
}
CV *
if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
cv = 0;
MUTEX_INIT(CvMUTEXP(cv));
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
- CvFILEGV(cv) = gv_fetchfile(filename);
+ (void)gv_fetchfile(filename);
+ CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be
+ an external constant string */
CvXSUB(cv) = subaddr;
if (name) {
s++;
else
s = name;
+
+ if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+ goto done;
+
if (strEQ(s, "BEGIN")) {
if (!PL_beginav)
PL_beginav = newAV();
- av_push(PL_beginav, (SV *)cv);
+ av_push(PL_beginav, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
else if (strEQ(s, "END")) {
if (!PL_endav)
PL_endav = newAV();
av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, (SV *)cv);
+ av_store(PL_endav, 0, SvREFCNT_inc(cv));
+ GvCV(gv) = 0;
+ }
+ else if (strEQ(s, "STOP")) {
+ if (!PL_stopav)
+ PL_stopav = newAV();
+ av_unshift(PL_stopav, 1);
+ av_store(PL_stopav, 0, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
else if (strEQ(s, "INIT")) {
if (!PL_initav)
PL_initav = newAV();
- av_push(PL_initav, (SV *)cv);
+ av_push(PL_initav, SvREFCNT_inc(cv));
GvCV(gv) = 0;
}
}
else
CvANON_on(cv);
+done:
return cv;
}
GvMULTI_on(gv);
if (cv = GvFORM(gv)) {
if (ckWARN(WARN_REDEFINE)) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
}
cv = PL_compcv;
GvFORM(gv) = cv;
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(cv) = PL_curcop->cop_filegv;
+ CvFILE(cv) = CopFILE(PL_curcop);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
}
CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
+ CvROOT(cv)->op_private |= OPpREFCOUNTED;
+ OpREFCNT_set(CvROOT(cv), 1);
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
peep(CvSTART(cv));
if (gv) {
kid->op_type = OP_GV;
SvREFCNT_dec(kid->op_sv);
+#ifdef USE_ITHREADS
+ /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+ kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
+ GvIN_PAD_on(gv);
+ PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
+#else
kid->op_sv = SvREFCNT_inc(gv);
+#endif
kid->op_ppaddr = PL_ppaddr[OP_GV];
}
}
dTHR;
I32 type = o->op_type;
- if (o->op_flags & OPf_REF)
- return o;
-
- if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+ if (o->op_flags & OPf_REF) {
+ /* nothing */
+ }
+ else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(type, OPf_REF,
gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
op_free(o);
- return newop;
+ o = newop;
}
}
else {
op_free(o);
if (type == OP_FTTTY)
- return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+ o = newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
SVt_PVIO));
else
- return newUNOP(type, 0, newDEFSVOP());
+ o = newUNOP(type, 0, newDEFSVOP());
+ }
+#ifdef USE_LOCALE
+ if (type == OP_FTTEXT || type == OP_FTBINARY) {
+ o->op_private = 0;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
}
+#endif
return o;
}
else {
I32 flags = OPf_SPECIAL;
I32 priv = 0;
+ PADOFFSET targ = 0;
+
/* is this op a FH constructor? */
if (is_handle_constructor(o,numargs)) {
- flags = 0;
- /* Set a flag to tell rv2gv to vivify
+ char *name = Nullch;
+ STRLEN len;
+
+ flags = 0;
+ /* Set a flag to tell rv2gv to vivify
* need to "prove" flag does not mean something
* else already - NI-S 1999/05/07
- */
- priv = OPpDEREF;
-#if 0
- /* Helps with open($array[$n],...)
- but is too simplistic - need to do selectively
- */
- mod(kid,type);
-#endif
+ */
+ priv = OPpDEREF;
+ if (kid->op_type == OP_PADSV) {
+ SV **namep = av_fetch(PL_comppad_name,
+ kid->op_targ, 4);
+ if (namep && *namep)
+ name = SvPV(*namep, len);
+ }
+ else if (kid->op_type == OP_RV2SV
+ && kUNOP->op_first->op_type == OP_GV)
+ {
+ GV *gv = cGVOPx_gv(kUNOP->op_first);
+ name = GvNAME(gv);
+ len = GvNAMELEN(gv);
+ }
+ if (name) {
+ SV *namesv;
+ targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+ namesv = PL_curpad[targ];
+ SvUPGRADE(namesv, SVt_PV);
+ if (*name != '$')
+ sv_setpvn(namesv, "$", 1);
+ sv_catpvn(namesv, name, len);
+ }
}
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, flags, scalar(kid));
- if (priv) {
- kid->op_private |= priv;
- }
+ kid->op_targ = targ;
+ kid->op_private |= priv;
}
kid->op_sibling = sibl;
*tokid = kid;
if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
-#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+#if !defined(PERL_EXTERNAL_GLOB)
/* XXX this can be tightened up and made more failsafe. */
if (!gv) {
OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
modname->op_private |= OPpCONST_BARE;
ENTER;
utilize(1, start_subparse(FALSE, 0), Nullop, modname,
- newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+ newSVOP(OP_CONST, 0, newSVpvn(":globally", 9)));
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
LEAVE;
}
-#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+#endif /* PERL_EXTERNAL_GLOB */
if (gv && GvIMPORTED_CV(gv)) {
append_elem(OP_GLOB, o,
return o;
}
kid->op_targ = kkid->op_targ;
+ kkid->op_targ = 0;
/* Now we do not need PADSV and SASSIGN. */
kid->op_sibling = o->op_sibling; /* NULL */
cLISTOPo->op_first = NULL;
register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
int reversed;
+ GV *gv;
if (!(o->op_flags & OPf_STACKED))
return;
GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
if (kUNOP->op_first->op_type != OP_GV)
return;
kid = kUNOP->op_first; /* get past rv2sv */
- if (GvSTASH(kGVOP->op_gv) != PL_curstash)
+ gv = kGVOP_gv;
+ if (GvSTASH(gv) != PL_curstash)
return;
- if (strEQ(GvNAME(kGVOP->op_gv), "a"))
+ if (strEQ(GvNAME(gv), "a"))
reversed = 0;
- else if(strEQ(GvNAME(kGVOP->op_gv), "b"))
+ else if(strEQ(GvNAME(gv), "b"))
reversed = 1;
else
return;
if (kUNOP->op_first->op_type != OP_GV)
return;
kid = kUNOP->op_first; /* get past rv2sv */
- if (GvSTASH(kGVOP->op_gv) != PL_curstash
+ gv = kGVOP_gv;
+ if (GvSTASH(gv) != PL_curstash
|| ( reversed
- ? strNE(GvNAME(kGVOP->op_gv), "a")
- : strNE(GvNAME(kGVOP->op_gv), "b")))
+ ? strNE(GvNAME(gv), "a")
+ : strNE(GvNAME(gv), "b")))
return;
o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
if (reversed)
null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
- cv = GvCVu(tmpop->op_sv);
+ GV *gv = cGVOPx_gv(tmpop);
+ cv = GvCVu(gv);
if (!cv)
tmpop->op_private |= OPpEARLY_CV;
else if (SvPOK(cv)) {
- namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
+ namegv = CvANON(cv) ? gv : CvGV(cv);
proto = SvPV((SV*)cv, n_a);
}
}
(gvop = ((UNOP*)gvop)->op_first) &&
gvop->op_type == OP_GV)
{
- GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+ GV *gv = cGVOPx_gv(gvop);
OP *sibling = o2->op_sibling;
SV *n = newSVpvn("",0);
op_free(o2);
return;
ENTER;
SAVEOP();
- SAVESPTR(PL_curcop);
+ SAVEVPTR(PL_curcop);
for (; o; o = o->op_next) {
if (o->op_seq)
break;
case OP_CONST:
if (cSVOPo->op_private & OPpCONST_STRICT)
no_bareword_allowed(o);
+#ifdef USE_ITHREADS
+ /* Relocate sv to the pad for thread safety.
+ * Despite being a "constant", the SV is written to,
+ * for reference counts, sv_upgrade() etc. */
+ if (cSVOP->op_sv) {
+ PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+ SvREFCNT_dec(PL_curpad[ix]);
+ SvPADTMP_on(cSVOPo->op_sv);
+ PL_curpad[ix] = cSVOPo->op_sv;
+ cSVOPo->op_sv = Nullsv;
+ o->op_targ = ix;
+ }
+#endif
/* FALL THROUGH */
case OP_UC:
case OP_UCFIRST:
&& (((LISTOP*)o)->op_first->op_sibling->op_type
== OP_PADSV)
&& (((LISTOP*)o)->op_first->op_sibling->op_targ
- == o->op_next->op_targ))) {
+ == o->op_next->op_targ)))
+ {
goto ignore_optimization;
}
else {
o->op_targ = o->op_next->op_targ;
+ o->op_next->op_targ = 0;
o->op_private |= OPpTARGET_MY;
}
}
<= 255 &&
i >= 0)
{
+ GV *gv;
null(o->op_next);
null(pop->op_next);
null(pop);
o->op_type = OP_AELEMFAST;
o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
o->op_private = (U8)i;
- GvAVn(((GVOP*)o)->op_gv);
+ gv = cGVOPo_gv;
+ GvAVn(gv);
}
}
else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
- GV *gv = cGVOPo->op_gv;
+ GV *gv = cGVOPo_gv;
if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
/* XXX could check prototype here instead of just carping */
SV *sv = sv_newmortal();
o->op_next->op_sibling->op_type != OP_EXIT &&
o->op_next->op_sibling->op_type != OP_WARN &&
o->op_next->op_sibling->op_type != OP_DIE) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
- PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
+ CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached");
Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
break;
fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
if (!fields || !GvHV(*fields))
break;
- svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+ svp = cSVOPx_svp(((BINOP*)o)->op_last);
key = SvPV(*svp, keylen);
indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
if (!indsvp) {
/* 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. */
/* Private for OP_DELETE */
#define OPpSLICE 64 /* Operating on a list of keys */
-/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */
+/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, OP_FTTEXT, OP_FTBINARY, */
+/* string comparisons, and case changers. */
#define OPpLOCALE 64 /* Use locale */
/* Private for OP_SORT */
SV * op_sv;
};
-struct gvop {
+struct padop {
BASEOP
- GV * op_gv;
+ PADOFFSET op_padix;
};
struct pvop {
OP * op_lastop;
};
-#define cUNOP ((UNOP*)PL_op)
-#define cBINOP ((BINOP*)PL_op)
-#define cLISTOP ((LISTOP*)PL_op)
-#define cLOGOP ((LOGOP*)PL_op)
-#define cPMOP ((PMOP*)PL_op)
-#define cSVOP ((SVOP*)PL_op)
-#define cGVOP ((GVOP*)PL_op)
-#define cPVOP ((PVOP*)PL_op)
-#define cCOP ((COP*)PL_op)
-#define cLOOP ((LOOP*)PL_op)
-
-#define cUNOPo ((UNOP*)o)
-#define cBINOPo ((BINOP*)o)
-#define cLISTOPo ((LISTOP*)o)
-#define cLOGOPo ((LOGOP*)o)
-#define cPMOPo ((PMOP*)o)
-#define cSVOPo ((SVOP*)o)
-#define cGVOPo ((GVOP*)o)
-#define cPVOPo ((PVOP*)o)
-#define cCVOPo ((CVOP*)o)
-#define cCOPo ((COP*)o)
-#define cLOOPo ((LOOP*)o)
-
-#define kUNOP ((UNOP*)kid)
-#define kBINOP ((BINOP*)kid)
-#define kLISTOP ((LISTOP*)kid)
-#define kLOGOP ((LOGOP*)kid)
-#define kPMOP ((PMOP*)kid)
-#define kSVOP ((SVOP*)kid)
-#define kGVOP ((GVOP*)kid)
-#define kPVOP ((PVOP*)kid)
-#define kCOP ((COP*)kid)
-#define kLOOP ((LOOP*)kid)
+#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*)PL_curpad[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 : PL_curpad[(v)->op_targ])
+# define cSVOPx_svp(v) (cSVOPx(v)->op_sv \
+ ? &cSVOPx(v)->op_sv : &PL_curpad[(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*)
#define OA_LISTOP (4 << OCSHIFT)
#define OA_PMOP (5 << OCSHIFT)
#define OA_SVOP (6 << OCSHIFT)
-#define OA_GVOP (7 << OCSHIFT)
+#define OA_PADOP (7 << OCSHIFT)
#define OA_PVOP_OR_SVOP (8 << OCSHIFT)
#define OA_LOOP (9 << OCSHIFT)
#define OA_COP (10 << OCSHIFT)
"private value",
"push regexp",
"ref-to-glob cast",
- "scalar deref",
+ "scalar dereference",
"array length",
- "subroutine deref",
+ "subroutine dereference",
"anonymous subroutine",
"subroutine prototype",
"reference constructor",
EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX);
#else
EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
- 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_i_preinc,
- Perl_pp_predec,
- Perl_pp_i_predec,
- Perl_pp_postinc,
- Perl_pp_i_postinc,
- Perl_pp_postdec,
- Perl_pp_i_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,
+ MEMBER_TO_FPTR(Perl_pp_null),
+ MEMBER_TO_FPTR(Perl_pp_stub),
+ MEMBER_TO_FPTR(Perl_pp_scalar),
+ MEMBER_TO_FPTR(Perl_pp_pushmark),
+ MEMBER_TO_FPTR(Perl_pp_wantarray),
+ MEMBER_TO_FPTR(Perl_pp_const),
+ MEMBER_TO_FPTR(Perl_pp_gvsv),
+ MEMBER_TO_FPTR(Perl_pp_gv),
+ MEMBER_TO_FPTR(Perl_pp_gelem),
+ MEMBER_TO_FPTR(Perl_pp_padsv),
+ MEMBER_TO_FPTR(Perl_pp_padav),
+ MEMBER_TO_FPTR(Perl_pp_padhv),
+ MEMBER_TO_FPTR(Perl_pp_padany),
+ MEMBER_TO_FPTR(Perl_pp_pushre),
+ MEMBER_TO_FPTR(Perl_pp_rv2gv),
+ MEMBER_TO_FPTR(Perl_pp_rv2sv),
+ MEMBER_TO_FPTR(Perl_pp_av2arylen),
+ MEMBER_TO_FPTR(Perl_pp_rv2cv),
+ MEMBER_TO_FPTR(Perl_pp_anoncode),
+ MEMBER_TO_FPTR(Perl_pp_prototype),
+ MEMBER_TO_FPTR(Perl_pp_refgen),
+ MEMBER_TO_FPTR(Perl_pp_srefgen),
+ MEMBER_TO_FPTR(Perl_pp_ref),
+ MEMBER_TO_FPTR(Perl_pp_bless),
+ MEMBER_TO_FPTR(Perl_pp_backtick),
+ MEMBER_TO_FPTR(Perl_pp_glob),
+ MEMBER_TO_FPTR(Perl_pp_readline),
+ MEMBER_TO_FPTR(Perl_pp_rcatline),
+ MEMBER_TO_FPTR(Perl_pp_regcmaybe),
+ MEMBER_TO_FPTR(Perl_pp_regcreset),
+ MEMBER_TO_FPTR(Perl_pp_regcomp),
+ MEMBER_TO_FPTR(Perl_pp_match),
+ MEMBER_TO_FPTR(Perl_pp_qr),
+ MEMBER_TO_FPTR(Perl_pp_subst),
+ MEMBER_TO_FPTR(Perl_pp_substcont),
+ MEMBER_TO_FPTR(Perl_pp_trans),
+ MEMBER_TO_FPTR(Perl_pp_sassign),
+ MEMBER_TO_FPTR(Perl_pp_aassign),
+ MEMBER_TO_FPTR(Perl_pp_chop),
+ MEMBER_TO_FPTR(Perl_pp_schop),
+ MEMBER_TO_FPTR(Perl_pp_chomp),
+ MEMBER_TO_FPTR(Perl_pp_schomp),
+ MEMBER_TO_FPTR(Perl_pp_defined),
+ MEMBER_TO_FPTR(Perl_pp_undef),
+ MEMBER_TO_FPTR(Perl_pp_study),
+ MEMBER_TO_FPTR(Perl_pp_pos),
+ MEMBER_TO_FPTR(Perl_pp_preinc),
+ MEMBER_TO_FPTR(Perl_pp_i_preinc),
+ MEMBER_TO_FPTR(Perl_pp_predec),
+ MEMBER_TO_FPTR(Perl_pp_i_predec),
+ MEMBER_TO_FPTR(Perl_pp_postinc),
+ MEMBER_TO_FPTR(Perl_pp_i_postinc),
+ MEMBER_TO_FPTR(Perl_pp_postdec),
+ MEMBER_TO_FPTR(Perl_pp_i_postdec),
+ MEMBER_TO_FPTR(Perl_pp_pow),
+ MEMBER_TO_FPTR(Perl_pp_multiply),
+ MEMBER_TO_FPTR(Perl_pp_i_multiply),
+ MEMBER_TO_FPTR(Perl_pp_divide),
+ MEMBER_TO_FPTR(Perl_pp_i_divide),
+ MEMBER_TO_FPTR(Perl_pp_modulo),
+ MEMBER_TO_FPTR(Perl_pp_i_modulo),
+ MEMBER_TO_FPTR(Perl_pp_repeat),
+ MEMBER_TO_FPTR(Perl_pp_add),
+ MEMBER_TO_FPTR(Perl_pp_i_add),
+ MEMBER_TO_FPTR(Perl_pp_subtract),
+ MEMBER_TO_FPTR(Perl_pp_i_subtract),
+ MEMBER_TO_FPTR(Perl_pp_concat),
+ MEMBER_TO_FPTR(Perl_pp_stringify),
+ MEMBER_TO_FPTR(Perl_pp_left_shift),
+ MEMBER_TO_FPTR(Perl_pp_right_shift),
+ MEMBER_TO_FPTR(Perl_pp_lt),
+ MEMBER_TO_FPTR(Perl_pp_i_lt),
+ MEMBER_TO_FPTR(Perl_pp_gt),
+ MEMBER_TO_FPTR(Perl_pp_i_gt),
+ MEMBER_TO_FPTR(Perl_pp_le),
+ MEMBER_TO_FPTR(Perl_pp_i_le),
+ MEMBER_TO_FPTR(Perl_pp_ge),
+ MEMBER_TO_FPTR(Perl_pp_i_ge),
+ MEMBER_TO_FPTR(Perl_pp_eq),
+ MEMBER_TO_FPTR(Perl_pp_i_eq),
+ MEMBER_TO_FPTR(Perl_pp_ne),
+ MEMBER_TO_FPTR(Perl_pp_i_ne),
+ MEMBER_TO_FPTR(Perl_pp_ncmp),
+ MEMBER_TO_FPTR(Perl_pp_i_ncmp),
+ MEMBER_TO_FPTR(Perl_pp_slt),
+ MEMBER_TO_FPTR(Perl_pp_sgt),
+ MEMBER_TO_FPTR(Perl_pp_sle),
+ MEMBER_TO_FPTR(Perl_pp_sge),
+ MEMBER_TO_FPTR(Perl_pp_seq),
+ MEMBER_TO_FPTR(Perl_pp_sne),
+ MEMBER_TO_FPTR(Perl_pp_scmp),
+ MEMBER_TO_FPTR(Perl_pp_bit_and),
+ MEMBER_TO_FPTR(Perl_pp_bit_xor),
+ MEMBER_TO_FPTR(Perl_pp_bit_or),
+ MEMBER_TO_FPTR(Perl_pp_negate),
+ MEMBER_TO_FPTR(Perl_pp_i_negate),
+ MEMBER_TO_FPTR(Perl_pp_not),
+ MEMBER_TO_FPTR(Perl_pp_complement),
+ MEMBER_TO_FPTR(Perl_pp_atan2),
+ MEMBER_TO_FPTR(Perl_pp_sin),
+ MEMBER_TO_FPTR(Perl_pp_cos),
+ MEMBER_TO_FPTR(Perl_pp_rand),
+ MEMBER_TO_FPTR(Perl_pp_srand),
+ MEMBER_TO_FPTR(Perl_pp_exp),
+ MEMBER_TO_FPTR(Perl_pp_log),
+ MEMBER_TO_FPTR(Perl_pp_sqrt),
+ MEMBER_TO_FPTR(Perl_pp_int),
+ MEMBER_TO_FPTR(Perl_pp_hex),
+ MEMBER_TO_FPTR(Perl_pp_oct),
+ MEMBER_TO_FPTR(Perl_pp_abs),
+ MEMBER_TO_FPTR(Perl_pp_length),
+ MEMBER_TO_FPTR(Perl_pp_substr),
+ MEMBER_TO_FPTR(Perl_pp_vec),
+ MEMBER_TO_FPTR(Perl_pp_index),
+ MEMBER_TO_FPTR(Perl_pp_rindex),
+ MEMBER_TO_FPTR(Perl_pp_sprintf),
+ MEMBER_TO_FPTR(Perl_pp_formline),
+ MEMBER_TO_FPTR(Perl_pp_ord),
+ MEMBER_TO_FPTR(Perl_pp_chr),
+ MEMBER_TO_FPTR(Perl_pp_crypt),
+ MEMBER_TO_FPTR(Perl_pp_ucfirst),
+ MEMBER_TO_FPTR(Perl_pp_lcfirst),
+ MEMBER_TO_FPTR(Perl_pp_uc),
+ MEMBER_TO_FPTR(Perl_pp_lc),
+ MEMBER_TO_FPTR(Perl_pp_quotemeta),
+ MEMBER_TO_FPTR(Perl_pp_rv2av),
+ MEMBER_TO_FPTR(Perl_pp_aelemfast),
+ MEMBER_TO_FPTR(Perl_pp_aelem),
+ MEMBER_TO_FPTR(Perl_pp_aslice),
+ MEMBER_TO_FPTR(Perl_pp_each),
+ MEMBER_TO_FPTR(Perl_pp_values),
+ MEMBER_TO_FPTR(Perl_pp_keys),
+ MEMBER_TO_FPTR(Perl_pp_delete),
+ MEMBER_TO_FPTR(Perl_pp_exists),
+ MEMBER_TO_FPTR(Perl_pp_rv2hv),
+ MEMBER_TO_FPTR(Perl_pp_helem),
+ MEMBER_TO_FPTR(Perl_pp_hslice),
+ MEMBER_TO_FPTR(Perl_pp_unpack),
+ MEMBER_TO_FPTR(Perl_pp_pack),
+ MEMBER_TO_FPTR(Perl_pp_split),
+ MEMBER_TO_FPTR(Perl_pp_join),
+ MEMBER_TO_FPTR(Perl_pp_list),
+ MEMBER_TO_FPTR(Perl_pp_lslice),
+ MEMBER_TO_FPTR(Perl_pp_anonlist),
+ MEMBER_TO_FPTR(Perl_pp_anonhash),
+ MEMBER_TO_FPTR(Perl_pp_splice),
+ MEMBER_TO_FPTR(Perl_pp_push),
+ MEMBER_TO_FPTR(Perl_pp_pop),
+ MEMBER_TO_FPTR(Perl_pp_shift),
+ MEMBER_TO_FPTR(Perl_pp_unshift),
+ MEMBER_TO_FPTR(Perl_pp_sort),
+ MEMBER_TO_FPTR(Perl_pp_reverse),
+ MEMBER_TO_FPTR(Perl_pp_grepstart),
+ MEMBER_TO_FPTR(Perl_pp_grepwhile),
+ MEMBER_TO_FPTR(Perl_pp_mapstart),
+ MEMBER_TO_FPTR(Perl_pp_mapwhile),
+ MEMBER_TO_FPTR(Perl_pp_range),
+ MEMBER_TO_FPTR(Perl_pp_flip),
+ MEMBER_TO_FPTR(Perl_pp_flop),
+ MEMBER_TO_FPTR(Perl_pp_and),
+ MEMBER_TO_FPTR(Perl_pp_or),
+ MEMBER_TO_FPTR(Perl_pp_xor),
+ MEMBER_TO_FPTR(Perl_pp_cond_expr),
+ MEMBER_TO_FPTR(Perl_pp_andassign),
+ MEMBER_TO_FPTR(Perl_pp_orassign),
+ MEMBER_TO_FPTR(Perl_pp_method),
+ MEMBER_TO_FPTR(Perl_pp_entersub),
+ MEMBER_TO_FPTR(Perl_pp_leavesub),
+ MEMBER_TO_FPTR(Perl_pp_leavesublv),
+ MEMBER_TO_FPTR(Perl_pp_caller),
+ MEMBER_TO_FPTR(Perl_pp_warn),
+ MEMBER_TO_FPTR(Perl_pp_die),
+ MEMBER_TO_FPTR(Perl_pp_reset),
+ MEMBER_TO_FPTR(Perl_pp_lineseq),
+ MEMBER_TO_FPTR(Perl_pp_nextstate),
+ MEMBER_TO_FPTR(Perl_pp_dbstate),
+ MEMBER_TO_FPTR(Perl_pp_unstack),
+ MEMBER_TO_FPTR(Perl_pp_enter),
+ MEMBER_TO_FPTR(Perl_pp_leave),
+ MEMBER_TO_FPTR(Perl_pp_scope),
+ MEMBER_TO_FPTR(Perl_pp_enteriter),
+ MEMBER_TO_FPTR(Perl_pp_iter),
+ MEMBER_TO_FPTR(Perl_pp_enterloop),
+ MEMBER_TO_FPTR(Perl_pp_leaveloop),
+ MEMBER_TO_FPTR(Perl_pp_return),
+ MEMBER_TO_FPTR(Perl_pp_last),
+ MEMBER_TO_FPTR(Perl_pp_next),
+ MEMBER_TO_FPTR(Perl_pp_redo),
+ MEMBER_TO_FPTR(Perl_pp_dump),
+ MEMBER_TO_FPTR(Perl_pp_goto),
+ MEMBER_TO_FPTR(Perl_pp_exit),
+ MEMBER_TO_FPTR(Perl_pp_open),
+ MEMBER_TO_FPTR(Perl_pp_close),
+ MEMBER_TO_FPTR(Perl_pp_pipe_op),
+ MEMBER_TO_FPTR(Perl_pp_fileno),
+ MEMBER_TO_FPTR(Perl_pp_umask),
+ MEMBER_TO_FPTR(Perl_pp_binmode),
+ MEMBER_TO_FPTR(Perl_pp_tie),
+ MEMBER_TO_FPTR(Perl_pp_untie),
+ MEMBER_TO_FPTR(Perl_pp_tied),
+ MEMBER_TO_FPTR(Perl_pp_dbmopen),
+ MEMBER_TO_FPTR(Perl_pp_dbmclose),
+ MEMBER_TO_FPTR(Perl_pp_sselect),
+ MEMBER_TO_FPTR(Perl_pp_select),
+ MEMBER_TO_FPTR(Perl_pp_getc),
+ MEMBER_TO_FPTR(Perl_pp_read),
+ MEMBER_TO_FPTR(Perl_pp_enterwrite),
+ MEMBER_TO_FPTR(Perl_pp_leavewrite),
+ MEMBER_TO_FPTR(Perl_pp_prtf),
+ MEMBER_TO_FPTR(Perl_pp_print),
+ MEMBER_TO_FPTR(Perl_pp_sysopen),
+ MEMBER_TO_FPTR(Perl_pp_sysseek),
+ MEMBER_TO_FPTR(Perl_pp_sysread),
+ MEMBER_TO_FPTR(Perl_pp_syswrite),
+ MEMBER_TO_FPTR(Perl_pp_send),
+ MEMBER_TO_FPTR(Perl_pp_recv),
+ MEMBER_TO_FPTR(Perl_pp_eof),
+ MEMBER_TO_FPTR(Perl_pp_tell),
+ MEMBER_TO_FPTR(Perl_pp_seek),
+ MEMBER_TO_FPTR(Perl_pp_truncate),
+ MEMBER_TO_FPTR(Perl_pp_fcntl),
+ MEMBER_TO_FPTR(Perl_pp_ioctl),
+ MEMBER_TO_FPTR(Perl_pp_flock),
+ MEMBER_TO_FPTR(Perl_pp_socket),
+ MEMBER_TO_FPTR(Perl_pp_sockpair),
+ MEMBER_TO_FPTR(Perl_pp_bind),
+ MEMBER_TO_FPTR(Perl_pp_connect),
+ MEMBER_TO_FPTR(Perl_pp_listen),
+ MEMBER_TO_FPTR(Perl_pp_accept),
+ MEMBER_TO_FPTR(Perl_pp_shutdown),
+ MEMBER_TO_FPTR(Perl_pp_gsockopt),
+ MEMBER_TO_FPTR(Perl_pp_ssockopt),
+ MEMBER_TO_FPTR(Perl_pp_getsockname),
+ MEMBER_TO_FPTR(Perl_pp_getpeername),
+ MEMBER_TO_FPTR(Perl_pp_lstat),
+ MEMBER_TO_FPTR(Perl_pp_stat),
+ MEMBER_TO_FPTR(Perl_pp_ftrread),
+ MEMBER_TO_FPTR(Perl_pp_ftrwrite),
+ MEMBER_TO_FPTR(Perl_pp_ftrexec),
+ MEMBER_TO_FPTR(Perl_pp_fteread),
+ MEMBER_TO_FPTR(Perl_pp_ftewrite),
+ MEMBER_TO_FPTR(Perl_pp_fteexec),
+ MEMBER_TO_FPTR(Perl_pp_ftis),
+ MEMBER_TO_FPTR(Perl_pp_fteowned),
+ MEMBER_TO_FPTR(Perl_pp_ftrowned),
+ MEMBER_TO_FPTR(Perl_pp_ftzero),
+ MEMBER_TO_FPTR(Perl_pp_ftsize),
+ MEMBER_TO_FPTR(Perl_pp_ftmtime),
+ MEMBER_TO_FPTR(Perl_pp_ftatime),
+ MEMBER_TO_FPTR(Perl_pp_ftctime),
+ MEMBER_TO_FPTR(Perl_pp_ftsock),
+ MEMBER_TO_FPTR(Perl_pp_ftchr),
+ MEMBER_TO_FPTR(Perl_pp_ftblk),
+ MEMBER_TO_FPTR(Perl_pp_ftfile),
+ MEMBER_TO_FPTR(Perl_pp_ftdir),
+ MEMBER_TO_FPTR(Perl_pp_ftpipe),
+ MEMBER_TO_FPTR(Perl_pp_ftlink),
+ MEMBER_TO_FPTR(Perl_pp_ftsuid),
+ MEMBER_TO_FPTR(Perl_pp_ftsgid),
+ MEMBER_TO_FPTR(Perl_pp_ftsvtx),
+ MEMBER_TO_FPTR(Perl_pp_fttty),
+ MEMBER_TO_FPTR(Perl_pp_fttext),
+ MEMBER_TO_FPTR(Perl_pp_ftbinary),
+ MEMBER_TO_FPTR(Perl_pp_chdir),
+ MEMBER_TO_FPTR(Perl_pp_chown),
+ MEMBER_TO_FPTR(Perl_pp_chroot),
+ MEMBER_TO_FPTR(Perl_pp_unlink),
+ MEMBER_TO_FPTR(Perl_pp_chmod),
+ MEMBER_TO_FPTR(Perl_pp_utime),
+ MEMBER_TO_FPTR(Perl_pp_rename),
+ MEMBER_TO_FPTR(Perl_pp_link),
+ MEMBER_TO_FPTR(Perl_pp_symlink),
+ MEMBER_TO_FPTR(Perl_pp_readlink),
+ MEMBER_TO_FPTR(Perl_pp_mkdir),
+ MEMBER_TO_FPTR(Perl_pp_rmdir),
+ MEMBER_TO_FPTR(Perl_pp_open_dir),
+ MEMBER_TO_FPTR(Perl_pp_readdir),
+ MEMBER_TO_FPTR(Perl_pp_telldir),
+ MEMBER_TO_FPTR(Perl_pp_seekdir),
+ MEMBER_TO_FPTR(Perl_pp_rewinddir),
+ MEMBER_TO_FPTR(Perl_pp_closedir),
+ MEMBER_TO_FPTR(Perl_pp_fork),
+ MEMBER_TO_FPTR(Perl_pp_wait),
+ MEMBER_TO_FPTR(Perl_pp_waitpid),
+ MEMBER_TO_FPTR(Perl_pp_system),
+ MEMBER_TO_FPTR(Perl_pp_exec),
+ MEMBER_TO_FPTR(Perl_pp_kill),
+ MEMBER_TO_FPTR(Perl_pp_getppid),
+ MEMBER_TO_FPTR(Perl_pp_getpgrp),
+ MEMBER_TO_FPTR(Perl_pp_setpgrp),
+ MEMBER_TO_FPTR(Perl_pp_getpriority),
+ MEMBER_TO_FPTR(Perl_pp_setpriority),
+ MEMBER_TO_FPTR(Perl_pp_time),
+ MEMBER_TO_FPTR(Perl_pp_tms),
+ MEMBER_TO_FPTR(Perl_pp_localtime),
+ MEMBER_TO_FPTR(Perl_pp_gmtime),
+ MEMBER_TO_FPTR(Perl_pp_alarm),
+ MEMBER_TO_FPTR(Perl_pp_sleep),
+ MEMBER_TO_FPTR(Perl_pp_shmget),
+ MEMBER_TO_FPTR(Perl_pp_shmctl),
+ MEMBER_TO_FPTR(Perl_pp_shmread),
+ MEMBER_TO_FPTR(Perl_pp_shmwrite),
+ MEMBER_TO_FPTR(Perl_pp_msgget),
+ MEMBER_TO_FPTR(Perl_pp_msgctl),
+ MEMBER_TO_FPTR(Perl_pp_msgsnd),
+ MEMBER_TO_FPTR(Perl_pp_msgrcv),
+ MEMBER_TO_FPTR(Perl_pp_semget),
+ MEMBER_TO_FPTR(Perl_pp_semctl),
+ MEMBER_TO_FPTR(Perl_pp_semop),
+ MEMBER_TO_FPTR(Perl_pp_require),
+ MEMBER_TO_FPTR(Perl_pp_dofile),
+ MEMBER_TO_FPTR(Perl_pp_entereval),
+ MEMBER_TO_FPTR(Perl_pp_leaveeval),
+ MEMBER_TO_FPTR(Perl_pp_entertry),
+ MEMBER_TO_FPTR(Perl_pp_leavetry),
+ MEMBER_TO_FPTR(Perl_pp_ghbyname),
+ MEMBER_TO_FPTR(Perl_pp_ghbyaddr),
+ MEMBER_TO_FPTR(Perl_pp_ghostent),
+ MEMBER_TO_FPTR(Perl_pp_gnbyname),
+ MEMBER_TO_FPTR(Perl_pp_gnbyaddr),
+ MEMBER_TO_FPTR(Perl_pp_gnetent),
+ MEMBER_TO_FPTR(Perl_pp_gpbyname),
+ MEMBER_TO_FPTR(Perl_pp_gpbynumber),
+ MEMBER_TO_FPTR(Perl_pp_gprotoent),
+ MEMBER_TO_FPTR(Perl_pp_gsbyname),
+ MEMBER_TO_FPTR(Perl_pp_gsbyport),
+ MEMBER_TO_FPTR(Perl_pp_gservent),
+ MEMBER_TO_FPTR(Perl_pp_shostent),
+ MEMBER_TO_FPTR(Perl_pp_snetent),
+ MEMBER_TO_FPTR(Perl_pp_sprotoent),
+ MEMBER_TO_FPTR(Perl_pp_sservent),
+ MEMBER_TO_FPTR(Perl_pp_ehostent),
+ MEMBER_TO_FPTR(Perl_pp_enetent),
+ MEMBER_TO_FPTR(Perl_pp_eprotoent),
+ MEMBER_TO_FPTR(Perl_pp_eservent),
+ MEMBER_TO_FPTR(Perl_pp_gpwnam),
+ MEMBER_TO_FPTR(Perl_pp_gpwuid),
+ MEMBER_TO_FPTR(Perl_pp_gpwent),
+ MEMBER_TO_FPTR(Perl_pp_spwent),
+ MEMBER_TO_FPTR(Perl_pp_epwent),
+ MEMBER_TO_FPTR(Perl_pp_ggrnam),
+ MEMBER_TO_FPTR(Perl_pp_ggrgid),
+ MEMBER_TO_FPTR(Perl_pp_ggrent),
+ MEMBER_TO_FPTR(Perl_pp_sgrent),
+ MEMBER_TO_FPTR(Perl_pp_egrent),
+ MEMBER_TO_FPTR(Perl_pp_getlogin),
+ MEMBER_TO_FPTR(Perl_pp_syscall),
+ MEMBER_TO_FPTR(Perl_pp_lock),
+ MEMBER_TO_FPTR(Perl_pp_threadsv),
+ MEMBER_TO_FPTR(Perl_pp_setstate),
+ MEMBER_TO_FPTR(Perl_pp_method_named),
};
#endif
EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op);
#else
EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
- Perl_ck_null, /* null */
- Perl_ck_null, /* stub */
- Perl_ck_fun, /* scalar */
- Perl_ck_null, /* pushmark */
- Perl_ck_null, /* wantarray */
- Perl_ck_svconst,/* const */
- Perl_ck_null, /* gvsv */
- Perl_ck_null, /* gv */
- Perl_ck_null, /* gelem */
- Perl_ck_null, /* padsv */
- Perl_ck_null, /* padav */
- Perl_ck_null, /* padhv */
- Perl_ck_null, /* padany */
- Perl_ck_null, /* pushre */
- Perl_ck_rvconst,/* rv2gv */
- Perl_ck_rvconst,/* rv2sv */
- Perl_ck_null, /* av2arylen */
- Perl_ck_rvconst,/* rv2cv */
- Perl_ck_anoncode,/* anoncode */
- Perl_ck_null, /* prototype */
- Perl_ck_spair, /* refgen */
- Perl_ck_null, /* srefgen */
- Perl_ck_fun, /* ref */
- Perl_ck_fun, /* bless */
- Perl_ck_null, /* backtick */
- Perl_ck_glob, /* glob */
- Perl_ck_null, /* readline */
- Perl_ck_null, /* rcatline */
- Perl_ck_fun, /* regcmaybe */
- Perl_ck_fun, /* regcreset */
- Perl_ck_null, /* regcomp */
- Perl_ck_match, /* match */
- Perl_ck_match, /* qr */
- Perl_ck_null, /* subst */
- Perl_ck_null, /* substcont */
- Perl_ck_null, /* trans */
- Perl_ck_sassign,/* sassign */
- Perl_ck_null, /* aassign */
- Perl_ck_spair, /* chop */
- Perl_ck_null, /* schop */
- Perl_ck_spair, /* chomp */
- Perl_ck_null, /* schomp */
- Perl_ck_defined,/* defined */
- Perl_ck_lfun, /* undef */
- Perl_ck_fun, /* study */
- Perl_ck_lfun, /* pos */
- Perl_ck_lfun, /* preinc */
- Perl_ck_lfun, /* i_preinc */
- Perl_ck_lfun, /* predec */
- Perl_ck_lfun, /* i_predec */
- Perl_ck_lfun, /* postinc */
- Perl_ck_lfun, /* i_postinc */
- Perl_ck_lfun, /* postdec */
- Perl_ck_lfun, /* i_postdec */
- Perl_ck_null, /* pow */
- Perl_ck_null, /* multiply */
- Perl_ck_null, /* i_multiply */
- Perl_ck_null, /* divide */
- Perl_ck_null, /* i_divide */
- Perl_ck_null, /* modulo */
- Perl_ck_null, /* i_modulo */
- Perl_ck_repeat, /* repeat */
- Perl_ck_null, /* add */
- Perl_ck_null, /* i_add */
- Perl_ck_null, /* subtract */
- Perl_ck_null, /* i_subtract */
- Perl_ck_concat, /* concat */
- Perl_ck_fun, /* stringify */
- Perl_ck_bitop, /* left_shift */
- Perl_ck_bitop, /* right_shift */
- Perl_ck_null, /* lt */
- Perl_ck_null, /* i_lt */
- Perl_ck_null, /* gt */
- Perl_ck_null, /* i_gt */
- Perl_ck_null, /* le */
- Perl_ck_null, /* i_le */
- Perl_ck_null, /* ge */
- Perl_ck_null, /* i_ge */
- Perl_ck_null, /* eq */
- Perl_ck_null, /* i_eq */
- Perl_ck_null, /* ne */
- Perl_ck_null, /* i_ne */
- Perl_ck_null, /* ncmp */
- Perl_ck_null, /* i_ncmp */
- Perl_ck_scmp, /* slt */
- Perl_ck_scmp, /* sgt */
- Perl_ck_scmp, /* sle */
- Perl_ck_scmp, /* sge */
- Perl_ck_null, /* seq */
- Perl_ck_null, /* sne */
- Perl_ck_scmp, /* scmp */
- Perl_ck_bitop, /* bit_and */
- Perl_ck_bitop, /* bit_xor */
- Perl_ck_bitop, /* bit_or */
- Perl_ck_null, /* negate */
- Perl_ck_null, /* i_negate */
- Perl_ck_null, /* not */
- Perl_ck_bitop, /* complement */
- Perl_ck_fun, /* atan2 */
- Perl_ck_fun, /* sin */
- Perl_ck_fun, /* cos */
- Perl_ck_fun, /* rand */
- Perl_ck_fun, /* srand */
- Perl_ck_fun, /* exp */
- Perl_ck_fun, /* log */
- Perl_ck_fun, /* sqrt */
- Perl_ck_fun, /* int */
- Perl_ck_fun, /* hex */
- Perl_ck_fun, /* oct */
- Perl_ck_fun, /* abs */
- Perl_ck_lengthconst,/* length */
- Perl_ck_fun, /* substr */
- Perl_ck_fun, /* vec */
- Perl_ck_index, /* index */
- Perl_ck_index, /* rindex */
- Perl_ck_fun_locale,/* sprintf */
- Perl_ck_fun, /* formline */
- Perl_ck_fun, /* ord */
- Perl_ck_fun, /* chr */
- Perl_ck_fun, /* crypt */
- Perl_ck_fun_locale,/* ucfirst */
- Perl_ck_fun_locale,/* lcfirst */
- Perl_ck_fun_locale,/* uc */
- Perl_ck_fun_locale,/* lc */
- Perl_ck_fun, /* quotemeta */
- Perl_ck_rvconst,/* rv2av */
- Perl_ck_null, /* aelemfast */
- Perl_ck_null, /* aelem */
- Perl_ck_null, /* aslice */
- Perl_ck_fun, /* each */
- Perl_ck_fun, /* values */
- Perl_ck_fun, /* keys */
- Perl_ck_delete, /* delete */
- Perl_ck_exists, /* exists */
- Perl_ck_rvconst,/* rv2hv */
- Perl_ck_null, /* helem */
- Perl_ck_null, /* hslice */
- Perl_ck_fun, /* unpack */
- Perl_ck_fun, /* pack */
- Perl_ck_split, /* split */
- Perl_ck_join, /* join */
- Perl_ck_null, /* list */
- Perl_ck_null, /* lslice */
- Perl_ck_fun, /* anonlist */
- Perl_ck_fun, /* anonhash */
- Perl_ck_fun, /* splice */
- Perl_ck_fun, /* push */
- Perl_ck_shift, /* pop */
- Perl_ck_shift, /* shift */
- Perl_ck_fun, /* unshift */
- Perl_ck_sort, /* sort */
- Perl_ck_fun, /* reverse */
- Perl_ck_grep, /* grepstart */
- Perl_ck_null, /* grepwhile */
- Perl_ck_grep, /* mapstart */
- Perl_ck_null, /* mapwhile */
- Perl_ck_null, /* range */
- Perl_ck_null, /* flip */
- Perl_ck_null, /* flop */
- Perl_ck_null, /* and */
- Perl_ck_null, /* or */
- Perl_ck_null, /* xor */
- Perl_ck_null, /* cond_expr */
- Perl_ck_null, /* andassign */
- Perl_ck_null, /* orassign */
- Perl_ck_method, /* method */
- Perl_ck_subr, /* entersub */
- Perl_ck_null, /* leavesub */
- Perl_ck_null, /* leavesublv */
- Perl_ck_fun, /* caller */
- Perl_ck_fun, /* warn */
- Perl_ck_fun, /* die */
- Perl_ck_fun, /* reset */
- Perl_ck_null, /* lineseq */
- Perl_ck_null, /* nextstate */
- Perl_ck_null, /* dbstate */
- Perl_ck_null, /* unstack */
- Perl_ck_null, /* enter */
- Perl_ck_null, /* leave */
- Perl_ck_null, /* scope */
- Perl_ck_null, /* enteriter */
- Perl_ck_null, /* iter */
- Perl_ck_null, /* enterloop */
- Perl_ck_null, /* leaveloop */
- Perl_ck_null, /* return */
- Perl_ck_null, /* last */
- Perl_ck_null, /* next */
- Perl_ck_null, /* redo */
- Perl_ck_null, /* dump */
- Perl_ck_null, /* goto */
- Perl_ck_fun, /* exit */
- Perl_ck_fun, /* open */
- Perl_ck_fun, /* close */
- Perl_ck_fun, /* pipe_op */
- Perl_ck_fun, /* fileno */
- Perl_ck_fun, /* umask */
- Perl_ck_fun, /* binmode */
- Perl_ck_fun, /* tie */
- Perl_ck_fun, /* untie */
- Perl_ck_fun, /* tied */
- Perl_ck_fun, /* dbmopen */
- Perl_ck_fun, /* dbmclose */
- Perl_ck_select, /* sselect */
- Perl_ck_select, /* select */
- Perl_ck_eof, /* getc */
- Perl_ck_fun, /* read */
- Perl_ck_fun, /* enterwrite */
- Perl_ck_null, /* leavewrite */
- Perl_ck_listiob,/* prtf */
- Perl_ck_listiob,/* print */
- Perl_ck_fun, /* sysopen */
- Perl_ck_fun, /* sysseek */
- Perl_ck_fun, /* sysread */
- Perl_ck_fun, /* syswrite */
- Perl_ck_fun, /* send */
- Perl_ck_fun, /* recv */
- Perl_ck_eof, /* eof */
- Perl_ck_fun, /* tell */
- Perl_ck_fun, /* seek */
- Perl_ck_trunc, /* truncate */
- Perl_ck_fun, /* fcntl */
- Perl_ck_fun, /* ioctl */
- Perl_ck_fun, /* flock */
- Perl_ck_fun, /* socket */
- Perl_ck_fun, /* sockpair */
- Perl_ck_fun, /* bind */
- Perl_ck_fun, /* connect */
- Perl_ck_fun, /* listen */
- Perl_ck_fun, /* accept */
- Perl_ck_fun, /* shutdown */
- Perl_ck_fun, /* gsockopt */
- Perl_ck_fun, /* ssockopt */
- Perl_ck_fun, /* getsockname */
- Perl_ck_fun, /* getpeername */
- Perl_ck_ftst, /* lstat */
- Perl_ck_ftst, /* stat */
- Perl_ck_ftst, /* ftrread */
- Perl_ck_ftst, /* ftrwrite */
- Perl_ck_ftst, /* ftrexec */
- Perl_ck_ftst, /* fteread */
- Perl_ck_ftst, /* ftewrite */
- Perl_ck_ftst, /* fteexec */
- Perl_ck_ftst, /* ftis */
- Perl_ck_ftst, /* fteowned */
- Perl_ck_ftst, /* ftrowned */
- Perl_ck_ftst, /* ftzero */
- Perl_ck_ftst, /* ftsize */
- Perl_ck_ftst, /* ftmtime */
- Perl_ck_ftst, /* ftatime */
- Perl_ck_ftst, /* ftctime */
- Perl_ck_ftst, /* ftsock */
- Perl_ck_ftst, /* ftchr */
- Perl_ck_ftst, /* ftblk */
- Perl_ck_ftst, /* ftfile */
- Perl_ck_ftst, /* ftdir */
- Perl_ck_ftst, /* ftpipe */
- Perl_ck_ftst, /* ftlink */
- Perl_ck_ftst, /* ftsuid */
- Perl_ck_ftst, /* ftsgid */
- Perl_ck_ftst, /* ftsvtx */
- Perl_ck_ftst, /* fttty */
- Perl_ck_ftst, /* fttext */
- Perl_ck_ftst, /* ftbinary */
- Perl_ck_fun, /* chdir */
- Perl_ck_fun, /* chown */
- Perl_ck_fun, /* chroot */
- Perl_ck_fun, /* unlink */
- Perl_ck_fun, /* chmod */
- Perl_ck_fun, /* utime */
- Perl_ck_fun, /* rename */
- Perl_ck_fun, /* link */
- Perl_ck_fun, /* symlink */
- Perl_ck_fun, /* readlink */
- Perl_ck_fun, /* mkdir */
- Perl_ck_fun, /* rmdir */
- Perl_ck_fun, /* open_dir */
- Perl_ck_fun, /* readdir */
- Perl_ck_fun, /* telldir */
- Perl_ck_fun, /* seekdir */
- Perl_ck_fun, /* rewinddir */
- Perl_ck_fun, /* closedir */
- Perl_ck_null, /* fork */
- Perl_ck_null, /* wait */
- Perl_ck_fun, /* waitpid */
- Perl_ck_exec, /* system */
- Perl_ck_exec, /* exec */
- Perl_ck_fun, /* kill */
- Perl_ck_null, /* getppid */
- Perl_ck_fun, /* getpgrp */
- Perl_ck_fun, /* setpgrp */
- Perl_ck_fun, /* getpriority */
- Perl_ck_fun, /* setpriority */
- Perl_ck_null, /* time */
- Perl_ck_null, /* tms */
- Perl_ck_fun, /* localtime */
- Perl_ck_fun, /* gmtime */
- Perl_ck_fun, /* alarm */
- Perl_ck_fun, /* sleep */
- Perl_ck_fun, /* shmget */
- Perl_ck_fun, /* shmctl */
- Perl_ck_fun, /* shmread */
- Perl_ck_fun, /* shmwrite */
- Perl_ck_fun, /* msgget */
- Perl_ck_fun, /* msgctl */
- Perl_ck_fun, /* msgsnd */
- Perl_ck_fun, /* msgrcv */
- Perl_ck_fun, /* semget */
- Perl_ck_fun, /* semctl */
- Perl_ck_fun, /* semop */
- Perl_ck_require,/* require */
- Perl_ck_fun, /* dofile */
- Perl_ck_eval, /* entereval */
- Perl_ck_null, /* leaveeval */
- Perl_ck_null, /* entertry */
- Perl_ck_null, /* leavetry */
- Perl_ck_fun, /* ghbyname */
- Perl_ck_fun, /* ghbyaddr */
- Perl_ck_null, /* ghostent */
- Perl_ck_fun, /* gnbyname */
- Perl_ck_fun, /* gnbyaddr */
- Perl_ck_null, /* gnetent */
- Perl_ck_fun, /* gpbyname */
- Perl_ck_fun, /* gpbynumber */
- Perl_ck_null, /* gprotoent */
- Perl_ck_fun, /* gsbyname */
- Perl_ck_fun, /* gsbyport */
- Perl_ck_null, /* gservent */
- Perl_ck_fun, /* shostent */
- Perl_ck_fun, /* snetent */
- Perl_ck_fun, /* sprotoent */
- Perl_ck_fun, /* sservent */
- Perl_ck_null, /* ehostent */
- Perl_ck_null, /* enetent */
- Perl_ck_null, /* eprotoent */
- Perl_ck_null, /* eservent */
- Perl_ck_fun, /* gpwnam */
- Perl_ck_fun, /* gpwuid */
- Perl_ck_null, /* gpwent */
- Perl_ck_null, /* spwent */
- Perl_ck_null, /* epwent */
- Perl_ck_fun, /* ggrnam */
- Perl_ck_fun, /* ggrgid */
- Perl_ck_null, /* ggrent */
- Perl_ck_null, /* sgrent */
- Perl_ck_null, /* egrent */
- Perl_ck_null, /* getlogin */
- Perl_ck_fun, /* syscall */
- Perl_ck_rfun, /* lock */
- Perl_ck_null, /* threadsv */
- Perl_ck_null, /* setstate */
- Perl_ck_null, /* method_named */
+ MEMBER_TO_FPTR(Perl_ck_null), /* null */
+ MEMBER_TO_FPTR(Perl_ck_null), /* stub */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* scalar */
+ MEMBER_TO_FPTR(Perl_ck_null), /* pushmark */
+ MEMBER_TO_FPTR(Perl_ck_null), /* wantarray */
+ MEMBER_TO_FPTR(Perl_ck_svconst), /* const */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gvsv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gelem */
+ MEMBER_TO_FPTR(Perl_ck_null), /* padsv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* padav */
+ MEMBER_TO_FPTR(Perl_ck_null), /* padhv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* padany */
+ MEMBER_TO_FPTR(Perl_ck_null), /* pushre */
+ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2gv */
+ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2sv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* av2arylen */
+ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2cv */
+ MEMBER_TO_FPTR(Perl_ck_anoncode), /* anoncode */
+ MEMBER_TO_FPTR(Perl_ck_null), /* prototype */
+ MEMBER_TO_FPTR(Perl_ck_spair), /* refgen */
+ MEMBER_TO_FPTR(Perl_ck_null), /* srefgen */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ref */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* bless */
+ MEMBER_TO_FPTR(Perl_ck_null), /* backtick */
+ MEMBER_TO_FPTR(Perl_ck_glob), /* glob */
+ MEMBER_TO_FPTR(Perl_ck_null), /* readline */
+ MEMBER_TO_FPTR(Perl_ck_null), /* rcatline */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* regcmaybe */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* regcreset */
+ MEMBER_TO_FPTR(Perl_ck_null), /* regcomp */
+ MEMBER_TO_FPTR(Perl_ck_match), /* match */
+ MEMBER_TO_FPTR(Perl_ck_match), /* qr */
+ MEMBER_TO_FPTR(Perl_ck_null), /* subst */
+ MEMBER_TO_FPTR(Perl_ck_null), /* substcont */
+ MEMBER_TO_FPTR(Perl_ck_null), /* trans */
+ MEMBER_TO_FPTR(Perl_ck_sassign), /* sassign */
+ MEMBER_TO_FPTR(Perl_ck_null), /* aassign */
+ MEMBER_TO_FPTR(Perl_ck_spair), /* chop */
+ MEMBER_TO_FPTR(Perl_ck_null), /* schop */
+ MEMBER_TO_FPTR(Perl_ck_spair), /* chomp */
+ MEMBER_TO_FPTR(Perl_ck_null), /* schomp */
+ MEMBER_TO_FPTR(Perl_ck_defined), /* defined */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* undef */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* study */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* pos */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* preinc */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* i_preinc */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* predec */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* i_predec */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* postinc */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postinc */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* postdec */
+ MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postdec */
+ MEMBER_TO_FPTR(Perl_ck_null), /* pow */
+ MEMBER_TO_FPTR(Perl_ck_null), /* multiply */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_multiply */
+ MEMBER_TO_FPTR(Perl_ck_null), /* divide */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_divide */
+ MEMBER_TO_FPTR(Perl_ck_null), /* modulo */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_modulo */
+ MEMBER_TO_FPTR(Perl_ck_repeat), /* repeat */
+ MEMBER_TO_FPTR(Perl_ck_null), /* add */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_add */
+ MEMBER_TO_FPTR(Perl_ck_null), /* subtract */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_subtract */
+ MEMBER_TO_FPTR(Perl_ck_concat), /* concat */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* stringify */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* left_shift */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* right_shift */
+ MEMBER_TO_FPTR(Perl_ck_null), /* lt */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_lt */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gt */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_gt */
+ MEMBER_TO_FPTR(Perl_ck_null), /* le */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_le */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ge */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_ge */
+ MEMBER_TO_FPTR(Perl_ck_null), /* eq */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_eq */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ne */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_ne */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ncmp */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_ncmp */
+ MEMBER_TO_FPTR(Perl_ck_scmp), /* slt */
+ MEMBER_TO_FPTR(Perl_ck_scmp), /* sgt */
+ MEMBER_TO_FPTR(Perl_ck_scmp), /* sle */
+ MEMBER_TO_FPTR(Perl_ck_scmp), /* sge */
+ MEMBER_TO_FPTR(Perl_ck_null), /* seq */
+ MEMBER_TO_FPTR(Perl_ck_null), /* sne */
+ MEMBER_TO_FPTR(Perl_ck_scmp), /* scmp */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_and */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_xor */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_or */
+ MEMBER_TO_FPTR(Perl_ck_null), /* negate */
+ MEMBER_TO_FPTR(Perl_ck_null), /* i_negate */
+ MEMBER_TO_FPTR(Perl_ck_null), /* not */
+ MEMBER_TO_FPTR(Perl_ck_bitop), /* complement */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* atan2 */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sin */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* cos */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* rand */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* srand */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* exp */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* log */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sqrt */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* int */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* hex */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* oct */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* abs */
+ MEMBER_TO_FPTR(Perl_ck_lengthconst), /* length */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* substr */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* vec */
+ MEMBER_TO_FPTR(Perl_ck_index), /* index */
+ MEMBER_TO_FPTR(Perl_ck_index), /* rindex */
+ MEMBER_TO_FPTR(Perl_ck_fun_locale), /* sprintf */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* formline */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ord */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* chr */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* crypt */
+ MEMBER_TO_FPTR(Perl_ck_fun_locale), /* ucfirst */
+ MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lcfirst */
+ MEMBER_TO_FPTR(Perl_ck_fun_locale), /* uc */
+ MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lc */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* quotemeta */
+ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2av */
+ MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */
+ MEMBER_TO_FPTR(Perl_ck_null), /* aelem */
+ MEMBER_TO_FPTR(Perl_ck_null), /* aslice */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* each */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* values */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* keys */
+ MEMBER_TO_FPTR(Perl_ck_delete), /* delete */
+ MEMBER_TO_FPTR(Perl_ck_exists), /* exists */
+ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2hv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* helem */
+ MEMBER_TO_FPTR(Perl_ck_null), /* hslice */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* unpack */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* pack */
+ MEMBER_TO_FPTR(Perl_ck_split), /* split */
+ MEMBER_TO_FPTR(Perl_ck_join), /* join */
+ MEMBER_TO_FPTR(Perl_ck_null), /* list */
+ MEMBER_TO_FPTR(Perl_ck_null), /* lslice */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* anonlist */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* anonhash */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* splice */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* push */
+ MEMBER_TO_FPTR(Perl_ck_shift), /* pop */
+ MEMBER_TO_FPTR(Perl_ck_shift), /* shift */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* unshift */
+ MEMBER_TO_FPTR(Perl_ck_sort), /* sort */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* reverse */
+ MEMBER_TO_FPTR(Perl_ck_grep), /* grepstart */
+ MEMBER_TO_FPTR(Perl_ck_null), /* grepwhile */
+ MEMBER_TO_FPTR(Perl_ck_grep), /* mapstart */
+ MEMBER_TO_FPTR(Perl_ck_null), /* mapwhile */
+ MEMBER_TO_FPTR(Perl_ck_null), /* range */
+ MEMBER_TO_FPTR(Perl_ck_null), /* flip */
+ MEMBER_TO_FPTR(Perl_ck_null), /* flop */
+ MEMBER_TO_FPTR(Perl_ck_null), /* and */
+ MEMBER_TO_FPTR(Perl_ck_null), /* or */
+ MEMBER_TO_FPTR(Perl_ck_null), /* xor */
+ MEMBER_TO_FPTR(Perl_ck_null), /* cond_expr */
+ MEMBER_TO_FPTR(Perl_ck_null), /* andassign */
+ MEMBER_TO_FPTR(Perl_ck_null), /* orassign */
+ MEMBER_TO_FPTR(Perl_ck_method), /* method */
+ MEMBER_TO_FPTR(Perl_ck_subr), /* entersub */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leavesub */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leavesublv */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* caller */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* warn */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* die */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* reset */
+ MEMBER_TO_FPTR(Perl_ck_null), /* lineseq */
+ MEMBER_TO_FPTR(Perl_ck_null), /* nextstate */
+ MEMBER_TO_FPTR(Perl_ck_null), /* dbstate */
+ MEMBER_TO_FPTR(Perl_ck_null), /* unstack */
+ MEMBER_TO_FPTR(Perl_ck_null), /* enter */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leave */
+ MEMBER_TO_FPTR(Perl_ck_null), /* scope */
+ MEMBER_TO_FPTR(Perl_ck_null), /* enteriter */
+ MEMBER_TO_FPTR(Perl_ck_null), /* iter */
+ MEMBER_TO_FPTR(Perl_ck_null), /* enterloop */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leaveloop */
+ MEMBER_TO_FPTR(Perl_ck_null), /* return */
+ MEMBER_TO_FPTR(Perl_ck_null), /* last */
+ MEMBER_TO_FPTR(Perl_ck_null), /* next */
+ MEMBER_TO_FPTR(Perl_ck_null), /* redo */
+ MEMBER_TO_FPTR(Perl_ck_null), /* dump */
+ MEMBER_TO_FPTR(Perl_ck_null), /* goto */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* exit */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* open */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* close */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* umask */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* binmode */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* tie */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* untie */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* tied */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* dbmopen */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* dbmclose */
+ MEMBER_TO_FPTR(Perl_ck_select), /* sselect */
+ MEMBER_TO_FPTR(Perl_ck_select), /* select */
+ MEMBER_TO_FPTR(Perl_ck_eof), /* getc */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* read */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* enterwrite */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leavewrite */
+ MEMBER_TO_FPTR(Perl_ck_listiob), /* prtf */
+ MEMBER_TO_FPTR(Perl_ck_listiob), /* print */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sysopen */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sysseek */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sysread */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* syswrite */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* send */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* recv */
+ MEMBER_TO_FPTR(Perl_ck_eof), /* eof */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* tell */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* seek */
+ MEMBER_TO_FPTR(Perl_ck_trunc), /* truncate */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* fcntl */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ioctl */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* flock */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* socket */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sockpair */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* bind */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* connect */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* listen */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* accept */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shutdown */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gsockopt */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ssockopt */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* getsockname */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* getpeername */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* lstat */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* stat */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrread */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrwrite */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrexec */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* fteread */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftewrite */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* fteexec */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftis */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* fteowned */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrowned */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftzero */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsize */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftmtime */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftatime */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftctime */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsock */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftchr */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftblk */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftfile */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftdir */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftpipe */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftlink */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsuid */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsgid */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsvtx */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* fttty */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* fttext */
+ MEMBER_TO_FPTR(Perl_ck_ftst), /* ftbinary */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* chdir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* chown */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* chroot */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* unlink */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* chmod */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* utime */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* rename */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* link */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* symlink */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* readlink */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* mkdir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* rmdir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* open_dir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* readdir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* telldir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* seekdir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* rewinddir */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* closedir */
+ MEMBER_TO_FPTR(Perl_ck_null), /* fork */
+ MEMBER_TO_FPTR(Perl_ck_null), /* wait */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* waitpid */
+ MEMBER_TO_FPTR(Perl_ck_exec), /* system */
+ MEMBER_TO_FPTR(Perl_ck_exec), /* exec */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* kill */
+ MEMBER_TO_FPTR(Perl_ck_null), /* getppid */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* getpgrp */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* setpgrp */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* getpriority */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* setpriority */
+ MEMBER_TO_FPTR(Perl_ck_null), /* time */
+ MEMBER_TO_FPTR(Perl_ck_null), /* tms */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* localtime */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gmtime */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* alarm */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sleep */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shmget */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shmctl */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shmread */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shmwrite */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* msgget */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* msgctl */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* msgsnd */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* msgrcv */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* semget */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* semctl */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* semop */
+ MEMBER_TO_FPTR(Perl_ck_require), /* require */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* dofile */
+ MEMBER_TO_FPTR(Perl_ck_eval), /* entereval */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leaveeval */
+ MEMBER_TO_FPTR(Perl_ck_null), /* entertry */
+ MEMBER_TO_FPTR(Perl_ck_null), /* leavetry */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyname */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyaddr */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ghostent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyname */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyaddr */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gnetent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gpbyname */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gpbynumber */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gprotoent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyname */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyport */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gservent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* shostent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* snetent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sprotoent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* sservent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ehostent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* enetent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* eprotoent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* eservent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gpwnam */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* gpwuid */
+ MEMBER_TO_FPTR(Perl_ck_null), /* gpwent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* spwent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* epwent */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ggrnam */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* ggrgid */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ggrent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* sgrent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* egrent */
+ MEMBER_TO_FPTR(Perl_ck_null), /* getlogin */
+ MEMBER_TO_FPTR(Perl_ck_fun), /* syscall */
+ MEMBER_TO_FPTR(Perl_ck_rfun), /* lock */
+ MEMBER_TO_FPTR(Perl_ck_null), /* threadsv */
+ MEMBER_TO_FPTR(Perl_ck_null), /* setstate */
+ MEMBER_TO_FPTR(Perl_ck_null), /* method_named */
};
#endif
0x00000004, /* pushmark */
0x00000014, /* wantarray */
0x00000c04, /* const */
- 0x00000e44, /* gvsv */
- 0x00000e44, /* gv */
+ 0x00000c44, /* gvsv */
+ 0x00000c44, /* gv */
0x00022440, /* gelem */
0x00000044, /* padsv */
0x00000040, /* padav */
0x0001368e, /* lc */
0x0001378e, /* quotemeta */
0x00000248, /* rv2av */
- 0x00026e04, /* aelemfast */
+ 0x00026c04, /* aelemfast */
0x00026404, /* aelem */
0x00046801, /* aslice */
0x00009600, /* each */
END
for (@ops) {
- print "\tPerl_pp_$_,\n";
+ print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n";
}
print <<END;
END
for (@ops) {
- print "\t", &tab(3, "Perl_$check{$_},"), "/* $_ */\n";
+ print "\t", &tab(3, "MEMBER_TO_FPTR(Perl_$check{$_}),"), "\t/* $_ */\n";
}
print <<END;
'|', 3, # logop
'@', 4, # listop
'/', 5, # pmop
- '$', 6, # svop
- '*', 7, # gvop
+ '$', 6, # svop_or_padop
+ '#', 7, # padop
'"', 8, # pvop_or_svop
'{', 9, # loop
';', 10, # cop
const constant item ck_svconst s$
-gvsv scalar variable ck_null ds*
-gv glob value ck_null ds*
+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
# References and stuff.
rv2gv ref-to-glob cast ck_rvconst ds1
-rv2sv scalar deref ck_rvconst ds1
+rv2sv scalar dereference ck_rvconst ds1
av2arylen array length ck_null is1
-rv2cv subroutine deref ck_rvconst d1
+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
# Arrays.
rv2av array dereference ck_rvconst dt1
-aelemfast constant array element ck_null s* A S
+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
# 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?
See C<t/rx*.t> for examples.
+=head1 ENVIRONMENT
+
+If C<PERL_REXX_DEBUG> is set, prints trace info on calls to REXX runtime
+environment.
+
=head1 AUTHOR
Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
#define BIT_BUCKET "/dev/nul" /* Will this work? */
# define PerlIO FILE
#endif
-#define TMPPATH tmppath
#define TMPPATH1 "plXXXXXX"
extern char *tmppath;
PerlIO *my_syspopen(char *cmd, char *mode);
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 5 /* epoch */
-#define PERL_SUBVERSION 62 /* generation */
+#define PERL_SUBVERSION 63 /* generation */
/* Compatibility across versions: MakeMaker will install add-on
modules in a directory with the PERL_APIVERSION version number.
See INSTALL for how this works.
*/
-#define PERL_APIVERSION 5.00562 /* Adjust manually as needed. */
+#define PERL_APIVERSION 5.00563 /* Adjust manually as needed. */
#define __PATCHLEVEL_H_INCLUDED__
#endif
#endif
#ifdef PERL_OBJECT
-CPerlObj*
-perl_alloc(struct IPerlMem* ipM, struct IPerlEnv* ipE,
- struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
- struct IPerlDir* ipD, struct IPerlSock* ipS,
- struct IPerlProc* ipP)
-{
- CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
- if (pPerl != NULL)
- pPerl->Init();
-
- return pPerl;
-}
-#else
+#define perl_construct Perl_construct
+#define perl_parse Perl_parse
+#define perl_run Perl_run
+#define perl_destruct Perl_destruct
+#define perl_free Perl_free
+#endif
#ifdef PERL_IMPLICIT_SYS
PerlInterpreter *
-perl_alloc_using(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
+ struct IPerlMem* ipMP, struct IPerlEnv* ipE,
struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
struct IPerlDir* ipD, struct IPerlSock* ipS,
struct IPerlProc* ipP)
{
PerlInterpreter *my_perl;
-
+#ifdef PERL_OBJECT
+ my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
+ ipLIO, ipD, ipS, ipP);
+ PERL_SET_INTERP(my_perl);
+#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
Zero(my_perl, 1, PerlInterpreter);
PL_Mem = ipM;
+ PL_MemShared = ipMS;
+ PL_MemParse = ipMP;
PL_Env = ipE;
PL_StdIO = ipStd;
PL_LIO = ipLIO;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
+#endif
+
return my_perl;
}
#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
+ Zero(my_perl, 1, PerlInterpreter);
return my_perl;
}
#endif /* PERL_IMPLICIT_SYS */
-#endif /* PERL_OBJECT */
void
perl_construct(pTHXx)
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
- DEBUG( {
- New(51,PL_debname,128,char);
- New(52,PL_debdelim,128,char);
- } )
-
ENTER;
}
dTHX;
#endif /* USE_THREADS */
+ /* wait for all pseudo-forked children to finish */
+ PERL_WAIT_FOR_CHILDREN;
+
#ifdef USE_THREADS
#ifndef FAKE_THREADS
/* Pass 1 on any remaining threads: detach joinables, join zombies */
PL_dowarn = G_WARN_OFF;
PL_doextract = FALSE;
PL_sawampersand = FALSE; /* must save all match strings */
- PL_sawstudy = FALSE; /* do fbm_instr on all strings */
- PL_sawvec = FALSE;
PL_unsafe = FALSE;
Safefree(PL_inplace);
/* startup and shutdown function lists */
SvREFCNT_dec(PL_beginav);
SvREFCNT_dec(PL_endav);
+ SvREFCNT_dec(PL_stopav);
SvREFCNT_dec(PL_initav);
PL_beginav = Nullav;
PL_endav = Nullav;
+ PL_stopav = Nullav;
PL_initav = Nullav;
/* shortcuts just get cleared */
PL_envgv = Nullgv;
- PL_siggv = Nullgv;
PL_incgv = Nullgv;
PL_hintgv = Nullgv;
PL_errgv = Nullgv;
PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
+ PL_debstash = Nullhv;
/* reset so print() ends up where we expect */
setdefout(Nullgv);
+ SvREFCNT_dec(PL_argvout_stack);
+ PL_argvout_stack = Nullav;
+
+ SvREFCNT_dec(PL_fdpid);
+ PL_fdpid = Nullav;
+ SvREFCNT_dec(PL_modglobal);
+ PL_modglobal = Nullhv;
+ SvREFCNT_dec(PL_preambleav);
+ PL_preambleav = Nullav;
+ SvREFCNT_dec(PL_subname);
+ PL_subname = Nullsv;
+ SvREFCNT_dec(PL_linestr);
+ PL_linestr = Nullsv;
+ SvREFCNT_dec(PL_pidstatus);
+ PL_pidstatus = Nullhv;
+ SvREFCNT_dec(PL_toptarget);
+ PL_toptarget = Nullsv;
+ SvREFCNT_dec(PL_bodytarget);
+ PL_bodytarget = Nullsv;
+ PL_formtarget = Nullsv;
+
+ /* clear utf8 character classes */
+ SvREFCNT_dec(PL_utf8_alnum);
+ SvREFCNT_dec(PL_utf8_alnumc);
+ SvREFCNT_dec(PL_utf8_ascii);
+ SvREFCNT_dec(PL_utf8_alpha);
+ SvREFCNT_dec(PL_utf8_space);
+ SvREFCNT_dec(PL_utf8_cntrl);
+ SvREFCNT_dec(PL_utf8_graph);
+ SvREFCNT_dec(PL_utf8_digit);
+ SvREFCNT_dec(PL_utf8_upper);
+ SvREFCNT_dec(PL_utf8_lower);
+ SvREFCNT_dec(PL_utf8_print);
+ SvREFCNT_dec(PL_utf8_punct);
+ SvREFCNT_dec(PL_utf8_xdigit);
+ SvREFCNT_dec(PL_utf8_mark);
+ SvREFCNT_dec(PL_utf8_toupper);
+ SvREFCNT_dec(PL_utf8_tolower);
+ PL_utf8_alnum = Nullsv;
+ PL_utf8_alnumc = Nullsv;
+ PL_utf8_ascii = Nullsv;
+ PL_utf8_alpha = Nullsv;
+ PL_utf8_space = Nullsv;
+ PL_utf8_cntrl = Nullsv;
+ PL_utf8_graph = Nullsv;
+ PL_utf8_digit = Nullsv;
+ PL_utf8_upper = Nullsv;
+ PL_utf8_lower = Nullsv;
+ PL_utf8_print = Nullsv;
+ PL_utf8_punct = Nullsv;
+ PL_utf8_xdigit = Nullsv;
+ PL_utf8_mark = Nullsv;
+ PL_utf8_toupper = Nullsv;
+ PL_utf8_totitle = Nullsv;
+ PL_utf8_tolower = Nullsv;
+
+ if (!specialWARN(PL_compiling.cop_warnings))
+ SvREFCNT_dec(PL_compiling.cop_warnings);
+ PL_compiling.cop_warnings = Nullsv;
+
/* Prepare to destruct main symbol table. */
hv = PL_defstash;
PL_defstash = 0;
SvREFCNT_dec(hv);
+ SvREFCNT_dec(PL_curstname);
+ PL_curstname = Nullsv;
/* clear queued errors */
SvREFCNT_dec(PL_errors);
sv_free_arenas();
/* No SVs have survived, need to clean out */
- PL_linestr = NULL;
- PL_pidstatus = Nullhv;
Safefree(PL_origfilename);
Safefree(PL_archpat_auto);
Safefree(PL_reg_start_tmp);
env, xsinit);
switch (ret) {
case 0:
+ if (PL_stopav)
+ call_list(oldscope, PL_stopav);
return 0;
case 1:
STATUS_ALL_FAILURE;
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav && !PL_minus_c)
- call_list(oldscope, PL_endav);
+ if (PL_stopav)
+ call_list(oldscope, PL_stopav);
return STATUS_NATIVE_EXPORT;
case 3:
PerlIO_printf(Perl_error_log, "panic: top_env\n");
AV* comppadlist;
register SV *sv;
register char *s;
+ char *cddir = Nullch;
XSINIT_t xsinit = va_arg(args, XSINIT_t);
PL_doextract = TRUE;
s++;
if (*s)
- PL_cddir = savepv(s);
+ cddir = s;
break;
case 0:
break;
}
#endif
- if (PL_doextract)
+ if (PL_doextract) {
find_beginning();
+ if (cddir && PerlDir_chdir(cddir) < 0)
+ Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+
+ }
PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
PL_origfilename);
}
}
- PL_curcop->cop_line = 0;
+ CopLINE_set(PL_curcop, 0);
PL_curstash = PL_defstash;
PL_preprocess = FALSE;
if (PL_e_script) {
if (PL_do_undump)
my_unexec();
- if (isWARN_ONCE)
+ if (isWARN_ONCE) {
+ SAVECOPFILE(PL_curcop);
+ SAVECOPLINE(PL_curcop);
gv_check(PL_defstash);
+ }
LEAVE;
FREETMPS;
if (!PL_restartop) {
DEBUG_x(dump_all());
DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
- DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n",
- (unsigned long) thr));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
+ PTR2UV(thr)));
if (PL_minus_c) {
PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
- if (PL_statusvalue)
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
- if (PL_statusvalue)
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
case '0':
{
dTHR;
- rschar = scan_oct(s, 4, &numlen);
+ rschar = (U32)scan_oct(s, 4, &numlen);
SvREFCNT_dec(PL_nrs);
if (rschar & ~((U8)~0))
PL_nrs = &PL_sv_undef;
if (isDIGIT(*s)) {
PL_ors = savepv("\n");
PL_orslen = 1;
- *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen);
+ *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
s += numlen;
}
else {
sv_catpv(sv, "})");
}
s += strlen(s);
- if (PL_preambleav == NULL)
+ if (!PL_preambleav)
PL_preambleav = newAV();
av_push(PL_preambleav, sv);
}
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
printf("\n(with %d registered patch%s, see perl -V for more detail)",
- LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
+ (int)LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
printf("\n\nCopyright 1987-1999, Larry Wall\n");
PL_curcop = &PL_compiling;\
PL_curcopdb = NULL; \
PL_dbargs = 0; \
- PL_dlmax = 128; \
PL_dumpindent = 4; \
PL_laststatval = -1; \
PL_laststype = OP_STAT; \
PL_tmps_floor = -1; \
PL_tmps_ix = -1; \
PL_op_mask = NULL; \
- PL_dlmax = 128; \
PL_laststatval = -1; \
PL_laststype = OP_STAT; \
PL_mess_sv = Nullsv; \
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
sv_setpvn(ERRSV, "", 0);
PL_curstash = PL_defstash;
- PL_compiling.cop_stash = PL_defstash;
+ CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
}
}
- PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+ CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
if (*fdscript >= 0) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
if (PL_euid &&
- PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 &&
+ PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 &&
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
#endif
#endif
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
- SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno));
+ CopFILE(PL_curcop), Strerror(errno));
}
}
STATIC int
S_fd_on_nosuid_fs(pTHX_ int fd)
{
- int on_nosuid = 0;
- int check_okay = 0;
+ int check_okay = 0; /* able to do all the required sys/libcalls */
+ int on_nosuid = 0; /* the fd is on a nosuid fs */
/*
- * Preferred order: fstatvfs(), fstatfs(), getmntent().
+ * Preferred order: fstatvfs(), fstatfs(), ustat()+getmnt(), getmntent().
* fstatvfs() is UNIX98.
- * fstatfs() is BSD.
- * getmntent() is O(number-of-mounted-filesystems) and can hang.
+ * fstatfs() is 4.3 BSD.
+ * ustat()+getmnt() is pre-4.3 BSD.
+ * getmntent() is O(number-of-mounted-filesystems) and can hang on
+ * an irrelevant filesystem while trying to reach the right one.
*/
# ifdef HAS_FSTATVFS
check_okay = fstatvfs(fd, &stfs) == 0;
on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
# else
-# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
+# ifdef PERL_MOUNT_NOSUID
+# if defined(HAS_FSTATFS) && \
+ defined(HAS_STRUCT_STATFS) && \
+ defined(HAS_STRUCT_STATFS_F_FLAGS)
struct statfs stfs;
check_okay = fstatfs(fd, &stfs) == 0;
-# undef PERL_MOUNT_NOSUID
-# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
-# define PERL_MOUNT_NOSUID MNT_NOSUID
-# endif
-# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
-# define PERL_MOUNT_NOSUID MS_NOSUID
-# endif
-# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
-# define PERL_MOUNT_NOSUID M_NOSUID
-# endif
-# ifdef PERL_MOUNT_NOSUID
on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
-# endif
+# else
+# if defined(HAS_FSTAT) && \
+ defined(HAS_USTAT) && \
+ defined(HAS_GETMNT) && \
+ defined(HAS_STRUCT_FS_DATA) &&
+ defined(NOSTAT_ONE)
+ struct stat fdst;
+ if (fstat(fd, &fdst) == 0) {
+ struct ustat us;
+ if (ustat(fdst.st_dev, &us) == 0) {
+ struct fs_data fsd;
+ /* NOSTAT_ONE here because we're not examining fields which
+ * vary between that case and STAT_ONE. */
+ if (getmnt((int*)0, &fsd, (int)0, NOSTAT_ONE, us.f_fname) == 0) {
+ size_t cmplen = sizeof(us.f_fname);
+ if (sizeof(fsd.fd_req.path) < cmplen)
+ cmplen = sizeof(fsd.fd_req.path);
+ if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
+ fdst.st_dev == fsd.fd_req.dev) {
+ check_okay = 1;
+ on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
+ }
+ }
+ }
+ }
+ }
+# endif /* fstat+ustat+getmnt */
+# endif /* fstatfs */
# else
-# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
+# if defined(HAS_GETMNTENT) && \
+ defined(HAS_HASMNTOPT) && \
+ defined(MNTOPT_NOSUID)
FILE *mtab = fopen("/etc/mtab", "r");
struct mntent *entry;
struct stat stb, fsb;
}
if (mtab)
fclose(mtab);
-# endif /* mntent */
-# endif /* statfs */
+# endif /* getmntent+hasmntopt */
+# endif /* PERL_MOUNT_NOSUID: fstatfs or fstat+ustat+statfs */
# endif /* statvfs */
+
if (!check_okay)
- Perl_croak(aTHX_ "Can't check filesystem of script \"%s\"", PL_origfilename);
+ Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename);
return on_nosuid;
}
#endif /* IAMSUID */
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/
+ if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/
Perl_croak(aTHX_ "Permission denied");
#else
/* If we can swap euid and uid, then we can determine access rights
#endif
|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
Perl_croak(aTHX_ "Can't swap uid and euid"); /* really paranoid */
- if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
+ if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0)
Perl_croak(aTHX_ "Permission denied"); /* testing full pathname here */
#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
(void)PerlIO_close(PL_rsfp);
if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */
PerlIO_printf(PL_rsfp,
-"User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
-(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
- (long)PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
+"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
+(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n",
+ PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
(long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
- SvPVX(GvSV(PL_curcop->cop_filegv)),
- (long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid);
+ CopFILE(PL_curcop),
+ PL_statbuf.st_uid, PL_statbuf.st_gid);
(void)PerlProc_pclose(PL_rsfp);
}
Perl_croak(aTHX_ "Permission denied\n");
if (PL_statbuf.st_mode & S_IWOTH)
Perl_croak(aTHX_ "Setuid/gid script is writable by world");
PL_doswitches = FALSE; /* -s is insecure in suid */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
Perl_croak(aTHX_ "No #! line");
/*SUPPRESS 530*/
while (s = moreswitches(s)) ;
}
- if (PL_cddir && PerlDir_chdir(PL_cddir) < 0)
- Perl_croak(aTHX_ "Can't chdir to %s",PL_cddir);
}
}
}
PL_markstack_ptr = PL_markstack;
PL_markstack_max = PL_markstack + REASONABLE(32);
- SET_MARKBASE;
+ SET_MARK_OFFSET;
New(54,PL_scopestack,REASONABLE(32),I32);
PL_scopestack_ix = 0;
Safefree(PL_scopestack);
Safefree(PL_savestack);
Safefree(PL_retstack);
- DEBUG( {
- Safefree(PL_debname);
- Safefree(PL_debdelim);
- } )
}
#ifndef PERL_OBJECT
}
TAINT_NOT;
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
- sv_setiv(GvSV(tmpgv), (IV)getpid());
+ sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
}
STATIC void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
dTHR;
- SV *atsv = ERRSV;
- line_t oldline = PL_curcop->cop_line;
+ SV *atsv;
+ line_t oldline = CopLINE(PL_curcop);
CV *cv;
STRLEN len;
int ret;
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
switch (ret) {
case 0:
+ atsv = ERRSV;
(void)SvPV(atsv, len);
if (len) {
+ STRLEN n_a;
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
sv_catpv(atsv, "BEGIN failed--compilation aborted");
else
- sv_catpv(atsv, "END failed--cleanup aborted");
+ Perl_sv_catpvf(aTHX_ atsv,
+ "%s failed--call queue aborted",
+ paramList == PL_stopav ? "STOP"
+ : paramList == PL_initav ? "INIT"
+ : "END");
while (PL_scopestack_ix > oldscope)
LEAVE;
- Perl_croak(aTHX_ "%s", SvPVX(atsv));
+ Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
}
break;
case 1:
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav && !PL_minus_c)
- call_list(oldscope, PL_endav);
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
- if (PL_statusvalue) {
+ CopLINE_set(PL_curcop, oldline);
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
if (paramList == PL_beginav)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
else
- Perl_croak(aTHX_ "END failed--cleanup aborted");
+ Perl_croak(aTHX_ "%s failed--call queue aborted",
+ paramList == PL_stopav ? "STOP"
+ : paramList == PL_initav ? "INIT"
+ : "END");
}
my_exit_jump();
/* NOTREACHED */
case 3:
if (PL_restartop) {
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
JMPENV_JUMP(3);
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
}
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
sv_chop(PL_e_script, nl);
return 1;
}
-
-
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
# endif
-# ifndef PERL_IMPLICIT_SYS
-# ifdef WIN32
-# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */
-# endif
-# endif
#endif
#if defined(MULTIPLICITY)
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
# endif
-# ifndef PERL_IMPLICIT_SYS
-# ifdef WIN32
-# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */
-# endif
-# endif
#endif
#ifdef PERL_CAPI
#define STATIC
#define CPERLscope(x) CPerlObj::x
-#define CALL_FPTR(fptr) (this->*fptr)
+#define CALL_FPTR(fptr) (aTHXo->*fptr)
#define pTHXo CPerlObj *pPerl
#define pTHXo_ pTHXo,
# include <stdlib.h>
#endif
-#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT)
+#if !defined(PERL_FOR_X2P) && !defined(WIN32)
# include "embed.h"
#endif
#undef UV
#endif
-#ifdef I_INTTYPES
-#include <inttypes.h>
-#endif
-
/*
The IV type is supposed to be long enough to hold any integral
value or a pointer.
--Andy Dougherty August 1996
*/
-/* We should be able to get Quad_t in most systems:
- all of int64_t, long long, long, int, will work.
-
- Beware of LP32 systems (ILP32, ILP32LL64). Such systems have been
- used to sizeof(long) == sizeof(foo*). This is a bad assumption
- because then IV/UV have been 32 bits, too. Which, in turn means
- that even if the system has quads (e.g. long long), IV cannot be a
- quad. Introducing a 64-bit IV (because of long long existing)
- will introduce binary incompatibility.
-
- Summary: a long long system needs to add -DUSE_LONG_LONG to $ccflags
- to get quads -- and if its pointers are still 32 bits, this will break
- binary compatibility. Casting an IV (a long long) to a pointer will
- truncate half of the IV away. Most systems can just use
- Configure -Duse64bits to get the -DUSE_LONG_LONG added either by
- their hints files, or directly by Configure if they are using gcc.
-
- --jhi September 1999 */
-
-#if INTSIZE == 4 && LONGSIZE == 4 && PTRSIZE == 4
-# define PERL_ILP32
-# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
-# define PERL_ILP32LL64
-# endif
-#endif
-
-#if LONGSIZE == 8 && PTRSIZE == 8
-# define PERL_LP64
-# if INTSIZE == 8
-# define PERL_ILP64
-# endif
-#endif
-
-#ifndef Quad_t
-# if LONGSIZE == 8
-# define Quad_t long
-# define Uquad_t unsigned long
-# define PERL_QUAD_IS_LONG
-# endif
-#endif
-
-#ifndef Quad_t
-# if INTSIZE == 8
-# define Quad_t int
-# define Uquad_t unsigned int
-# define PERL_QUAD_IS_INT
-# endif
-#endif
-
-#ifndef Quad_t
-# ifdef USE_LONG_LONG /* See above note about LP32. --jhi */
-# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
-# define Quad_t long long
-# define Uquad_t unsigned long long
-# define PERL_QUAD_IS_LONG_LONG
-# endif
-# endif
-#endif
-
-#ifndef Quad_t
-# ifdef HAS_INT64_T
-# define Quad_t int64_t
-# define Uquad_t uint64_t
-# define PERL_QUAD_IS_INT64_T
-# endif
-#endif
-
-#ifdef Quad_t
-# define HAS_QUAD
-# ifndef Uquad_t
- /* Note that if your Quad_t is a typedef (not a #define) you *MUST*
- * have defined by now Uquad_t yourself because 'unsigned type'
- * is illegal. */
-# define Uquad_t unsigned Quad_t
-# endif
-#endif
+typedef IVTYPE IV;
+typedef UVTYPE UV;
#if defined(USE_64_BITS) && defined(HAS_QUAD)
-# ifdef PERL_QUAD_IS_LONG /* LP64 */
- typedef long IV;
- typedef unsigned long UV;
-# else
-# ifdef PERL_QUAD_IS_INT /* ILP64 */
- typedef int IV;
- typedef unsigned int UV;
-# else
-# ifdef PERL_QUAD_IS_LONG_LONG /* LL64 */
- typedef long long IV;
- typedef unsigned long long UV;
-# else
-# ifdef PERL_QUAD_IS_INT64_T /* C9X */
- typedef int64_t IV;
- typedef uint64_t UV;
-# endif
-# endif
-# endif
-# endif
-# if defined(PERL_QUAD_IS_INT64_T) && defined(INT64_MAX)
+# if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX)
# define IV_MAX INT64_MAX
# define IV_MIN INT64_MIN
# define UV_MAX UINT64_MAX
# define UV_MAX PERL_UQUAD_MAX
# define UV_MIN PERL_UQUAD_MIN
# endif
-# define IVSIZE 8
-# define UVSIZE 8
# define IV_IS_QUAD
# define UV_IS_QUAD
#else
- typedef long IV;
- typedef unsigned long UV;
-# if defined(INT32_MAX) && LONGSIZE == 4
+# if defined(INT32_MAX) && IVSIZE == 4
# define IV_MAX INT32_MAX
# define IV_MIN INT32_MIN
# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
# define UV_MAX PERL_ULONG_MAX
# define UV_MIN PERL_ULONG_MIN
# endif
-# if LONGSIZE == 8
+# if IVSIZE == 8
# define IV_IS_QUAD
# define UV_IS_QUAD
+# ifndef HAS_QUAD
+# define HAS_QUAD
+# endif
# else
# undef IV_IS_QUAD
# undef UV_IS_QUAD
+# undef HAS_QUAD
# endif
-# define UVSIZE LONGSIZE
-# define IVSIZE LONGSIZE
#endif
+
#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
#define PTR2NV(p) NUM2PTR(NV,p)
#ifdef USE_LONG_DOUBLE
-# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
-# define LDoub_t long double
-# else
+# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
# undef USE_LONG_DOUBLE /* Ouch! */
# endif
#endif
default value for printing floating point numbers in Gconvert.
(see config.h)
*/
-#ifdef I_LIMITS
-#include <limits.h>
-#endif
-#ifdef I_FLOAT
-#include <float.h>
-#endif
-#ifndef HAS_LDBL_DIG
-#if LONG_DOUBLESIZE == 10
-#define LDBL_DIG 18 /* assume IEEE */
-#else
-#if LONG_DOUBLESIZE == 16
-#define LDBL_DIG 33 /* assume IEEE */
-#else
-#if LONG_DOUBLESIZE == DOUBLESIZE
-#define LDBL_DIG DBL_DIG /* bummer */
-#endif
-#endif
-#endif
-#endif
+# ifdef I_LIMITS
+# include <limits.h>
+# endif
+# ifdef I_FLOAT
+# include <float.h>
+# endif
+# ifndef HAS_LDBL_DIG
+# if LONG_DOUBLESIZE == 10
+# define LDBL_DIG 18 /* assume IEEE */
+# else
+# if LONG_DOUBLESIZE == 12
+# define LDBL_DIG 18 /* gcc? */
+# else
+# if LONG_DOUBLESIZE == 16
+# define LDBL_DIG 33 /* assume IEEE */
+# else
+# if LONG_DOUBLESIZE == DOUBLESIZE
+# define LDBL_DIG DBL_DIG /* bummer */
+# endif
+# endif
+# endif
+# endif
+# endif
#endif
+typedef NVTYPE NV;
+
#ifdef USE_LONG_DOUBLE
-# define HAS_LDOUB
- typedef LDoub_t NV;
-# define NVSIZE LONG_DOUBLESIZE
# define NV_DIG LDBL_DIG
-# define Perl_modf modfl
-# define Perl_frexp frexpl
-# define Perl_cos cosl
-# define Perl_sin sinl
-# define Perl_sqrt sqrtl
-# define Perl_exp expl
-# define Perl_log logl
-# define Perl_atan2 atan2l
-# define Perl_pow powl
-# define Perl_floor floorl
-# define Perl_fmod fmodl
+# ifdef HAS_SQRTL
+# define Perl_modf modfl
+# define Perl_frexp frexpl
+# define Perl_cos cosl
+# define Perl_sin sinl
+# define Perl_sqrt sqrtl
+# define Perl_exp expl
+# define Perl_log logl
+# define Perl_atan2 atan2l
+# define Perl_pow powl
+# define Perl_floor floorl
+# define Perl_fmod fmodl
+# endif
#else
- typedef double NV;
-# define NVSIZE DOUBLESIZE
# define NV_DIG DBL_DIG
# define Perl_modf modf
# define Perl_frexp frexp
# endif
#endif
-#ifdef HAS_QUAD
+#ifdef UV_IS_QUAD
# ifdef UQUAD_MAX
# define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
typedef struct logop LOGOP;
typedef struct pmop PMOP;
typedef struct svop SVOP;
-typedef struct gvop GVOP;
+typedef struct padop PADOP;
typedef struct pvop PVOP;
typedef struct loop LOOP;
-typedef struct Outrec Outrec;
typedef struct interpreter PerlInterpreter;
typedef struct sv SV;
typedef struct av AV;
typedef struct xpvio XPVIO;
typedef struct mgvtbl MGVTBL;
typedef union any ANY;
+typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
+typedef struct ptr_tbl PTR_TBL_t;
#include "handy.h"
-#if defined(USE_LARGE_FILES)
-# define USE_64_BIT_RAWIO /* Explicit */
-# define USE_64_BIT_STDIO
+#ifndef NO_LARGE_FILES
+# define USE_LARGE_FILES /* If available. */
#endif
-#if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
-# define USE_64_BIT_RAWIO /* Implicit */
+#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
+# define USE_64_BIT_RAWIO /* explicit */
+# if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
+# define USE_64_BIT_RAWIO /* implicit */
+# endif
#endif
-/* Do we need FSEEKSIZE? */
+/* Notice the use of HAS_FSEEKO: now we are obligated to always use
+ * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself,
+ * however, because operating systems like to do that themself. */
+#ifndef FSEEKSIZE
+# ifdef HAS_FSEEKO
+# define FSEEKSIZE LSEEKSIZE
+# else
+# define FSEEKSIZE LONGSIZE
+# endif
+#endif
-/* I couldn't find any -Ddefine or -flags in IRIX 6.5 that would
- * have done the necessary symbol renaming using cpp. --jhi */
-#ifdef __sgi
-#define USE_FOPEN64
-#define USE_FSEEK64
-#define USE_FTELL64
-#define USE_FSETPOS64
-#define USE_FGETPOS64
-#define USE_TMPFILE64
-#define USE_FREOPEN64
+#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO)
+# define USE_64_BIT_STDIO /* explicit */
+# if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO)
+# define USE_64_BIT_STDIO /* implicit */
+# endif
#endif
#ifdef USE_64_BIT_RAWIO
# endif
# if defined(USE_LSEEK64)
# define lseek lseek64
-# endif
-# if defined(USE_LLSEEK)
-# define lseek llseek
+# else
+# if defined(USE_LLSEEK)
+# define lseek llseek
+# endif
# endif
# if defined(USE_STAT64)
# define stat stat64
# define fopen fopen64
# endif
# if defined(USE_FSEEK64)
-# define fseek fseek64
+# define fseek fseek64 /* don't do fseeko here, see perlio.c */
# endif
# if defined(USE_FTELL64)
-# define ftell ftell64
+# define ftell ftell64 /* don't do ftello here, see perlio.c */
# endif
# if defined(USE_FSETPOS64)
# define fsetpos fsetpos64
# if defined(EPOC)
# include "epocish.h"
# else
-# include "unixish.h"
+# if defined(MACOS_TRADITIONAL)
+# include "macos/macish.h"
+# else
+# include "unixish.h"
+# endif
# endif
# endif
# endif
# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
#endif
+#ifndef PERL_SYS_INIT3
+# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
+#endif
+
#ifndef MAXPATHLEN
# ifdef PATH_MAX
# ifdef _POSIX_PATH_MAX
# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
#endif
+/* flags in PL_exit_flags for nature of exit() */
+#define PERL_EXIT_EXPECTED 0x01
+
#ifndef MEMBER_TO_FPTR
#define MEMBER_TO_FPTR(name) name
#endif
# endif
#endif
+#ifndef PERL_WAIT_FOR_CHILDREN
+# define PERL_WAIT_FOR_CHILDREN NOOP
+#endif
+
/* the traditional thread-unsafe notion of "current interpreter".
* XXX todo: a thread-safe version that fetches it from TLS (akin to THR)
* needs to be defined elsewhere (conditional on pthread_getspecific()
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
struct scan_data_t; /* Used in S_* functions in regcomp.c */
+struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
typedef I32 CHECKPOINT;
+struct ptr_tbl_ent {
+ struct ptr_tbl_ent* next;
+ void* oldval;
+ void* newval;
+};
+
+struct ptr_tbl {
+ struct ptr_tbl_ent** tbl_ary;
+ UV tbl_max;
+ UV tbl_items;
+};
+
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
-/* Believe. */
-#define IV_FITS_IN_NV
-/* Doubt. */
-#if defined(USE_LONG_DOUBLE) && \
- defined(LDBL_MANT_DIG) && IV_DIG >= LDBL_MANT_DIG
-# undef IV_FITS_IN_NV
-#else
-# if defined(DBL_MANT_DIG) && IV_DIG >= DBL_MANT_DIG
-# undef IV_FITS_IN_NV
-# else
-# if IV_DIG >= NV_DIG
-# undef IV_FITS_IN_NV
-# else
-# if IVSIZE >= NVSIZE
-# undef IV_FITS_IN_NV
-# endif
-# endif
-# endif
-#endif
-
-#ifdef IV_IS_QUAD
-# define UVuf PERL_PRIu64
-# define IVdf PERL_PRId64
-# define UVof PERL_PRIo64
-# define UVxf PERL_PRIx64
-#else
-# if LONGSIZE == 4
-# define UVuf "lu"
-# define IVdf "ld"
-# define UVof "lo"
-# define UVxf "lx"
-# else
- /* Any good ideas? */
-# endif
-#endif
-
/* Used with UV/IV arguments: */
/* XXXX: need to speed it up */
#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv))
#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
-struct Outrec {
- I32 o_lines;
- char *o_str;
- U32 o_len;
-};
-
#ifndef MAXSYSFD
# define MAXSYSFD 2
#endif
-#ifndef TMPPATH
-# define TMPPATH "/tmp/perl-eXXXXXX"
-#endif
-
#ifndef __cplusplus
Uid_t getuid (void);
Uid_t geteuid (void);
# if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
char *crypt (); /* Maybe more hosts will need the unprototyped version */
# else
-# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
+# if !defined(WIN32)
char *crypt (const char*, const char*);
-# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
+# endif /* !WIN32 */
# endif /* !NeXT && !__NeXT__ */
# ifndef DONT_DECLARE_STD
# ifndef getenv
# endif
#endif
-typedef Signal_t (*Sighandler_t) (int);
+/* Sighandler_t defined in iperlsys.h */
#ifdef HAS_SIGACTION
typedef struct sigaction Sigsave_t;
/* handy constants */
EXTCONST char PL_warn_uninit[]
- INIT("Use of uninitialized value");
+ INIT("Use of uninitialized value%s%s");
EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
EXTCONST char PL_warn_reserved[]
#ifdef DOINIT
EXT char *PL_sig_name[] = { SIG_NAME };
EXT int PL_sig_num[] = { SIG_NUM };
-EXT SV * PL_psig_ptr[sizeof(PL_sig_num)/sizeof(*PL_sig_num)];
-EXT SV * PL_psig_name[sizeof(PL_sig_num)/sizeof(*PL_sig_num)];
#else
EXT char *PL_sig_name[];
EXT int PL_sig_num[];
-EXT SV * PL_psig_ptr[];
-EXT SV * PL_psig_name[];
#endif
/* fast case folding tables */
void *ptr;
} PerlExitListEntry;
-#ifdef PERL_OBJECT
-#undef perl_alloc
-#define perl_alloc Perl_alloc
-CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
-
-#undef EXT
-#define EXT
-#undef EXTCONST
-#define EXTCONST
-#undef INIT
-#define INIT(x)
-
-class CPerlObj {
-public:
- CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
- void Init(void);
- void* operator new(size_t nSize, IPerlMem *pvtbl);
- static void operator delete(void* pPerl, IPerlMem *pvtbl);
-#endif /* PERL_OBJECT */
-
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
-#include "perlvars.h"
+# include "perlvars.h"
};
-#ifdef PERL_CORE
+# ifdef PERL_CORE
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
-#else /* PERL_CORE */
-#if !defined(__GNUC__) || !defined(WIN32)
+# else /* PERL_CORE */
+# if !defined(__GNUC__) || !defined(WIN32)
EXT
-#endif /* WIN32 */
+# endif /* WIN32 */
struct perl_vars *PL_VarsPtr;
-#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars())))
-#endif /* PERL_CORE */
+# define PL_Vars (*((PL_VarsPtr) \
+ ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX))))
+# endif /* PERL_CORE */
#endif /* PERL_GLOBAL_STRUCT */
-#ifdef MULTIPLICITY
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT)
/* If we have multiple interpreters define a struct
holding variables which must be per-interpreter
If we don't have threads anything that would have
*/
struct interpreter {
-#ifndef USE_THREADS
-# include "thrdvar.h"
-#endif
-#include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
+# include "intrpvar.h"
+/*
+ * The following is a buffer where new variables must
+ * be defined to maintain binary compatibility with PERL_OBJECT
+ */
+PERLVARA(object_compatibility,30, char)
};
#else
struct interpreter {
char broiled;
};
-#endif
+#endif /* MULTIPLICITY || PERL_OBJECT */
#ifdef USE_THREADS
/* If we have threads define a struct with all the variables
# define PERL_CALLCONV
#endif
-#ifdef PERL_OBJECT
-# define VIRTUAL virtual PERL_CALLCONV
-#else
-# define VIRTUAL PERL_CALLCONV
-/*START_EXTERN_C*/
-#endif
-
#ifndef NEXT30_NO_ATTRIBUTE
# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
# ifdef __attribute__ /* Avoid possible redefinition errors */
#endif
#ifdef PERL_OBJECT
-#define PERL_DECL_PROT
-#define perl_alloc Perl_alloc
+# define PERL_DECL_PROT
#endif
-#include "proto.h"
-
#undef PERL_CKDEF
#undef PERL_PPDEF
#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
#define PERL_PPDEF(s) OP *s (pTHX);
-#ifdef PERL_OBJECT
-public:
-#endif
-#include "pp_proto.h"
+#include "proto.h"
#ifdef PERL_OBJECT
-VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp);
-#undef PERL_DECL_PROT
-#else
-/*END_EXTERN_C*/
+# undef PERL_DECL_PROT
#endif
#ifndef PERL_OBJECT
#define PERLVARI(var,type,init) EXT type PL_##var INIT(init);
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
-#ifndef MULTIPLICITY
-
+#if !defined(MULTIPLICITY) && !defined(PERL_OBJECT)
+START_EXTERN_C
# include "intrpvar.h"
# ifndef USE_THREADS
# include "thrdvar.h"
# endif
-
+END_EXTERN_C
#endif
#ifdef PERL_OBJECT
-/*
- * The following is a buffer where new variables must
- * be defined to maintain binary compatibility with PERL_OBJECT
- * for 5.005
- */
-PERLVARA(object_compatibility,30, char)
-};
-
-
# include "embed.h"
-# if defined(WIN32) && !defined(WIN32IO_IS_STDIO)
-# define errno CPerlObj::ErrorNo()
-# endif
# ifdef DOINIT
# include "INTERN.h"
/* this has structure inits, so it cannot be included before here */
# include "opcode.h"
+#else
+# if defined(WIN32)
+# include "embed.h"
+# endif
#endif /* PERL_OBJECT */
#ifndef PERL_GLOBAL_STRUCT
#ifdef DOINIT
-EXT MGVTBL PL_vtbl_sv = {Perl_magic_get,
- Perl_magic_set,
- Perl_magic_len,
+EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get),
+ MEMBER_TO_FPTR(Perl_magic_set),
+ MEMBER_TO_FPTR(Perl_magic_len),
0, 0};
-EXT MGVTBL PL_vtbl_env = {0, Perl_magic_set_all_env,
- 0, Perl_magic_clear_all_env,
+EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env),
+ 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env),
0};
-EXT MGVTBL PL_vtbl_envelem = {0, Perl_magic_setenv,
- 0, Perl_magic_clearenv,
+EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv),
+ 0, MEMBER_TO_FPTR(Perl_magic_clearenv),
0};
EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0};
-EXT MGVTBL PL_vtbl_sigelem = {Perl_magic_getsig,
- Perl_magic_setsig,
- 0, Perl_magic_clearsig,
+EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig),
+ MEMBER_TO_FPTR(Perl_magic_setsig),
+ 0, MEMBER_TO_FPTR(Perl_magic_clearsig),
0};
-EXT MGVTBL PL_vtbl_pack = {0, 0, Perl_magic_sizepack, Perl_magic_wipepack,
+EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack),
0};
-EXT MGVTBL PL_vtbl_packelem = {Perl_magic_getpack,
- Perl_magic_setpack,
- 0, Perl_magic_clearpack,
+EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack),
+ MEMBER_TO_FPTR(Perl_magic_setpack),
+ 0, MEMBER_TO_FPTR(Perl_magic_clearpack),
0};
-EXT MGVTBL PL_vtbl_dbline = {0, Perl_magic_setdbline,
+EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline),
0, 0, 0};
-EXT MGVTBL PL_vtbl_isa = {0, Perl_magic_setisa,
- 0, Perl_magic_setisa,
+EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa),
+ 0, MEMBER_TO_FPTR(Perl_magic_setisa),
0};
-EXT MGVTBL PL_vtbl_isaelem = {0, Perl_magic_setisa,
+EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa),
0, 0, 0};
-EXT MGVTBL PL_vtbl_arylen = {Perl_magic_getarylen,
- Perl_magic_setarylen,
+EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen),
+ MEMBER_TO_FPTR(Perl_magic_setarylen),
0, 0, 0};
-EXT MGVTBL PL_vtbl_glob = {Perl_magic_getglob,
- Perl_magic_setglob,
+EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob),
+ MEMBER_TO_FPTR(Perl_magic_setglob),
0, 0, 0};
-EXT MGVTBL PL_vtbl_mglob = {0, Perl_magic_setmglob,
+EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob),
0, 0, 0};
-EXT MGVTBL PL_vtbl_nkeys = {Perl_magic_getnkeys,
- Perl_magic_setnkeys,
+EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys),
+ MEMBER_TO_FPTR(Perl_magic_setnkeys),
0, 0, 0};
-EXT MGVTBL PL_vtbl_taint = {Perl_magic_gettaint,Perl_magic_settaint,
+EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint),
0, 0, 0};
-EXT MGVTBL PL_vtbl_substr = {Perl_magic_getsubstr, Perl_magic_setsubstr,
+EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr),
0, 0, 0};
-EXT MGVTBL PL_vtbl_vec = {Perl_magic_getvec,
- Perl_magic_setvec,
+EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec),
+ MEMBER_TO_FPTR(Perl_magic_setvec),
0, 0, 0};
-EXT MGVTBL PL_vtbl_pos = {Perl_magic_getpos,
- Perl_magic_setpos,
+EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos),
+ MEMBER_TO_FPTR(Perl_magic_setpos),
0, 0, 0};
-EXT MGVTBL PL_vtbl_bm = {0, Perl_magic_setbm,
+EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm),
0, 0, 0};
-EXT MGVTBL PL_vtbl_fm = {0, Perl_magic_setfm,
+EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm),
0, 0, 0};
-EXT MGVTBL PL_vtbl_uvar = {Perl_magic_getuvar,
- Perl_magic_setuvar,
+EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar),
+ MEMBER_TO_FPTR(Perl_magic_setuvar),
0, 0, 0};
#ifdef USE_THREADS
-EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, Perl_magic_mutexfree};
+EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_mutexfree)};
#endif /* USE_THREADS */
-EXT MGVTBL PL_vtbl_defelem = {Perl_magic_getdefelem,Perl_magic_setdefelem,
+EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem),
0, 0, 0};
-EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, Perl_magic_freeregexp};
-EXT MGVTBL PL_vtbl_regdata = {0, 0, Perl_magic_regdata_cnt, 0, 0};
-EXT MGVTBL PL_vtbl_regdatum = {Perl_magic_regdatum_get, 0, 0, 0, 0};
+EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
+EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
+EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 0, 0, 0, 0};
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL PL_vtbl_collxfrm = {0,
- Perl_magic_setcollxfrm,
+ MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
0, 0, 0};
#endif
-EXT MGVTBL PL_vtbl_amagic = {0, Perl_magic_setamagic,
- 0, 0, Perl_magic_setamagic};
-EXT MGVTBL PL_vtbl_amagicelem = {0, Perl_magic_setamagic,
- 0, 0, Perl_magic_setamagic};
+EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic),
+ 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)};
+EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic),
+ 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)};
EXT MGVTBL PL_vtbl_backref = {0, 0,
- 0, 0, Perl_magic_killbackrefs};
+ 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)};
#else /* !DOINIT */
* Now we have __attribute__ out of the way
* Remap printf
*/
+#undef printf
#define printf PerlIO_stdoutf
#endif
#endif
/*
+ * Some operating systems are stingy with stack allocation,
+ * so perl may have to guard against stack overflow.
+ */
+#ifndef PERL_STACK_OVERFLOW_CHECK
+#define PERL_STACK_OVERFLOW_CHECK() NOOP
+#endif
+
+/*
+ * Some nonpreemptive operating systems find it convenient to
+ * check for asynchronous conditions after each op execution.
+ * Keep this check simple, or it may slow down execution
+ * massively.
+ */
+#ifndef PERL_ASYNC_CHECK
+#define PERL_ASYNC_CHECK() NOOP
+#endif
+
+/*
+ * On some operating systems, a memory allocation may succeed,
+ * but put the process too close to the system's comfort limit.
+ * In this case, PERL_ALLOC_CHECK frees the pointer and sets
+ * it to NULL.
+ */
+#ifndef PERL_ALLOC_CHECK
+#define PERL_ALLOC_CHECK(p) NOOP
+#endif
+
+/*
* nice_chunk and nice_chunk size need to be set
* and queried under the protection of sv_mutex
*/
# endif
#endif
-/* Mention
-
- INSTALL_USR_BIN_PERL
-
- I_SYS_MMAN
- HAS_MMAP
- HAS_MUNMAP
- HAS_MPROTECT
- HAS_MSYNC
- HAS_MADVISE
- Mmap_t
-
- here so that Configure picks them up. */
-
#ifdef IAMSUID
#ifdef I_SYS_STATVFS
#ifdef I_MNTENT
# include <mntent.h> /* for getmntent() */
#endif
+#ifdef I_SYS_STATFS
+# include <sys/statfs.h> /* for some statfs() */
+#endif
+#ifdef I_SYS_VFS
+# ifdef __sgi
+# define sv IRIX_sv /* kludge: IRIX has an sv of its own */
+# endif
+# include <sys/vfs.h> /* for some statfs() */
+# ifdef __sgi
+# undef IRIX_sv
+# endif
+#endif
+#ifdef I_USTAT
+# include <ustat.h> /* for ustat() */
+#endif
+
+#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
+# define PERL_MOUNT_NOSUID MOUNT_NOSUID
+#endif
+#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
+# define PERL_MOUNT_NOSUID MNT_NOSUID
+#endif
+#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
+# define PERL_MOUNT_NOSUID MS_NOSUID
+#endif
+#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
+# define PERL_MOUNT_NOSUID M_NOSUID
+#endif
#endif /* IAMSUID */
#undef PERLVARI
#undef PERLVARIC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \
- { return &(aTHXo->PL_##v); }
+ { return &(aTHXo->interp.v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \
- { return &(aTHXo->PL_##v); }
+ { return &(aTHXo->interp.v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
#undef PERLVARI
#undef PERLVARIC
+#if defined(PERL_IMPLICIT_SYS)
+#else
+#endif
+#if defined(USE_ITHREADS)
+# if defined(PERL_IMPLICIT_SYS)
+# endif
+#endif
+#if defined(MYMALLOC)
+#endif
+#if defined(PERL_OBJECT)
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#undef Perl_amagic_call
((CPerlObj*)pPerl)->Perl_vdeb(pat, args);
}
-#undef Perl_deb_growlevel
-void
-Perl_deb_growlevel(pTHXo)
-{
- ((CPerlObj*)pPerl)->Perl_deb_growlevel();
-}
-
#undef Perl_debprofdump
void
Perl_debprofdump(pTHXo)
{
((CPerlObj*)pPerl)->Perl_magicname(sym, name, namlen);
}
-#if defined(MYMALLOC)
-
-#undef Perl_malloced_size
-MEM_SIZE
-Perl_malloced_size(void *p)
-{
- dTHXo;
- return ((CPerlObj*)pPerl)->Perl_malloced_size(p);
-}
-#endif
#undef Perl_markstack_grow
void
return ((CPerlObj*)pPerl)->Perl_newLISTOP(type, flags, first, last);
}
+#undef Perl_newPADOP
+OP*
+Perl_newPADOP(pTHXo_ I32 type, I32 flags, SV* sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_newPADOP(type, flags, sv);
+}
+
#undef Perl_newPMOP
OP*
Perl_newPMOP(pTHXo_ I32 type, I32 flags)
((CPerlObj*)pPerl)->Perl_peep(o);
}
#if defined(PERL_OBJECT)
-#else
-#undef perl_alloc
-PerlInterpreter*
-perl_alloc()
+#undef Perl_construct
+void
+Perl_construct(pTHXo)
{
- dTHXo;
- return ((CPerlObj*)pPerl)->perl_alloc();
+ ((CPerlObj*)pPerl)->Perl_construct();
+}
+
+#undef Perl_destruct
+void
+Perl_destruct(pTHXo)
+{
+ ((CPerlObj*)pPerl)->Perl_destruct();
+}
+
+#undef Perl_free
+void
+Perl_free(pTHXo)
+{
+ ((CPerlObj*)pPerl)->Perl_free();
+}
+
+#undef Perl_run
+int
+Perl_run(pTHXo)
+{
+ return ((CPerlObj*)pPerl)->Perl_run();
}
+
+#undef Perl_parse
+int
+Perl_parse(pTHXo_ XSINIT_t xsinit, int argc, char** argv, char** env)
+{
+ return ((CPerlObj*)pPerl)->Perl_parse(xsinit, argc, argv, env);
+}
+#endif
#if defined(USE_THREADS)
#undef Perl_new_struct_thread
return ((CPerlObj*)pPerl)->Perl_new_struct_thread(t);
}
#endif
-#endif
#undef Perl_call_atexit
void
((CPerlObj*)pPerl)->Perl_save_I32(intp);
}
+#undef Perl_save_I8
+void
+Perl_save_I8(pTHXo_ I8* bytep)
+{
+ ((CPerlObj*)pPerl)->Perl_save_I8(bytep);
+}
+
#undef Perl_save_int
void
Perl_save_int(pTHXo_ int* intp)
((CPerlObj*)pPerl)->Perl_save_pptr(pptr);
}
+#undef Perl_save_vptr
+void
+Perl_save_vptr(pTHXo_ void* pptr)
+{
+ ((CPerlObj*)pPerl)->Perl_save_vptr(pptr);
+}
+
#undef Perl_save_re_context
void
Perl_save_re_context(pTHXo)
#undef Perl_taint_proper
void
-Perl_taint_proper(pTHXo_ const char* f, char* s)
+Perl_taint_proper(pTHXo_ const char* f, const char* s)
{
((CPerlObj*)pPerl)->Perl_taint_proper(f, s);
}
return ((CPerlObj*)pPerl)->Perl_wait4pid(pid, statusp, flags);
}
+#undef Perl_report_uninit
+void
+Perl_report_uninit(pTHXo)
+{
+ ((CPerlObj*)pPerl)->Perl_report_uninit();
+}
+
#undef Perl_warn
void
Perl_warn(pTHXo_ const char* pat, ...)
{
((CPerlObj*)pPerl)->Perl_dump_mstats(s);
}
-
-#undef Perl_malloc
-Malloc_t
-Perl_malloc(MEM_SIZE nbytes)
-{
- dTHXo;
- return ((CPerlObj*)pPerl)->Perl_malloc(nbytes);
-}
-
-#undef Perl_calloc
-Malloc_t
-Perl_calloc(MEM_SIZE elements, MEM_SIZE size)
-{
- dTHXo;
- return ((CPerlObj*)pPerl)->Perl_calloc(elements, size);
-}
-
-#undef Perl_realloc
-Malloc_t
-Perl_realloc(Malloc_t where, MEM_SIZE nbytes)
-{
- dTHXo;
- return ((CPerlObj*)pPerl)->Perl_realloc(where, nbytes);
-}
-
-#undef Perl_mfree
-Free_t
-Perl_mfree(Malloc_t where)
-{
- dTHXo;
- ((CPerlObj*)pPerl)->Perl_mfree(where);
-}
#endif
#undef Perl_safesysmalloc
{
((CPerlObj*)pPerl)->Perl_boot_core_xsutils();
}
+#if defined(USE_ITHREADS)
+
+#undef Perl_cx_dup
+PERL_CONTEXT*
+Perl_cx_dup(pTHXo_ PERL_CONTEXT* cx, I32 ix, I32 max)
+{
+ return ((CPerlObj*)pPerl)->Perl_cx_dup(cx, ix, max);
+}
+
+#undef Perl_si_dup
+PERL_SI*
+Perl_si_dup(pTHXo_ PERL_SI* si)
+{
+ return ((CPerlObj*)pPerl)->Perl_si_dup(si);
+}
+
+#undef Perl_ss_dup
+ANY*
+Perl_ss_dup(pTHXo_ PerlInterpreter* proto_perl)
+{
+ return ((CPerlObj*)pPerl)->Perl_ss_dup(proto_perl);
+}
+
+#undef Perl_any_dup
+void*
+Perl_any_dup(pTHXo_ void* v, PerlInterpreter* proto_perl)
+{
+ return ((CPerlObj*)pPerl)->Perl_any_dup(v, proto_perl);
+}
+
+#undef Perl_he_dup
+HE*
+Perl_he_dup(pTHXo_ HE* e, bool shared)
+{
+ return ((CPerlObj*)pPerl)->Perl_he_dup(e, shared);
+}
+
+#undef Perl_re_dup
+REGEXP*
+Perl_re_dup(pTHXo_ REGEXP* r)
+{
+ return ((CPerlObj*)pPerl)->Perl_re_dup(r);
+}
+
+#undef Perl_fp_dup
+PerlIO*
+Perl_fp_dup(pTHXo_ PerlIO* fp, char type)
+{
+ return ((CPerlObj*)pPerl)->Perl_fp_dup(fp, type);
+}
+
+#undef Perl_dirp_dup
+DIR*
+Perl_dirp_dup(pTHXo_ DIR* dp)
+{
+ return ((CPerlObj*)pPerl)->Perl_dirp_dup(dp);
+}
+
+#undef Perl_gp_dup
+GP*
+Perl_gp_dup(pTHXo_ GP* gp)
+{
+ return ((CPerlObj*)pPerl)->Perl_gp_dup(gp);
+}
+
+#undef Perl_mg_dup
+MAGIC*
+Perl_mg_dup(pTHXo_ MAGIC* mg)
+{
+ return ((CPerlObj*)pPerl)->Perl_mg_dup(mg);
+}
+
+#undef Perl_sv_dup
+SV*
+Perl_sv_dup(pTHXo_ SV* sstr)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_dup(sstr);
+}
+#if defined(HAVE_INTERP_INTERN)
+
+#undef Perl_sys_intern_dup
+void
+Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst)
+{
+ ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst);
+}
+#endif
+
+#undef Perl_ptr_table_new
+PTR_TBL_t*
+Perl_ptr_table_new(pTHXo)
+{
+ return ((CPerlObj*)pPerl)->Perl_ptr_table_new();
+}
+
+#undef Perl_ptr_table_fetch
+void*
+Perl_ptr_table_fetch(pTHXo_ PTR_TBL_t *tbl, void *sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_ptr_table_fetch(tbl, sv);
+}
+
+#undef Perl_ptr_table_store
+void
+Perl_ptr_table_store(pTHXo_ PTR_TBL_t *tbl, void *oldsv, void *newsv)
+{
+ ((CPerlObj*)pPerl)->Perl_ptr_table_store(tbl, oldsv, newsv);
+}
+
+#undef Perl_ptr_table_split
+void
+Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl)
+{
+ ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl);
+}
+#endif
#if defined(PERL_OBJECT)
+#else
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
#endif
# if defined(LEAKTEST)
# endif
#endif
+#if defined(PERL_OBJECT)
+#endif
#undef Perl_ck_anoncode
OP *
dTHXo;
va_list(arglist);
va_start(arglist, format);
- return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist);
+ return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist);
}
END_EXTERN_C
#line 338 "perly.y"
{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
- || strEQ(name, "INIT"))
+ || strEQ(name, "STOP") || strEQ(name, "INIT"))
CvSPECIAL_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
}
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
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, "STOP") || strEQ(name, "INIT"))
CvSPECIAL_on(PL_compcv);
$$ = $1; }
;
yyaccept:
! return (0);
}
---- 2524,2570 ----
+--- 2524,2569 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
! }
!
! #ifdef PERL_OBJECT
-! #define NO_XSLOCKS
! #include "XSUB.h"
! #endif
!
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
#define BIT_BUCKET "/dev/null"
#define PERL_SYS_INIT(c,v) MALLOC_INIT
perlmod.pod \
perlmodlib.pod \
perlmodinstall.pod \
+ perlfork.pod \
perlform.pod \
perllocale.pod \
perlref.pod \
perlmod.man \
perlmodlib.man \
perlmodinstall.man \
+ perlfork.man \
perlform.man \
perllocale.man \
perlref.man \
perlmod.html \
perlmodlib.html \
perlmodinstall.html \
+ perlfork.html \
perlform.html \
perllocale.html \
perlref.html \
perlmod.tex \
perlmodlib.tex \
perlmodinstall.tex \
+ perlfork.tex \
perlform.tex \
perllocale.tex \
perlref.tex \
=item Win32::CopyFile(FROM, TO, OVERWRITE)
-The Win32::CopyFile() function copies an existing file to a new file. All
-file information like creation time and file attributes will be copied to
-the new file. However it will B<not> copy the security information. If the
-destination file already exists it will only be overwritten when the
-OVERWRITE parameter is true. But even this will not overwrite a read-only
-file; you have to unlink() it first yourself.
+[CORE] The Win32::CopyFile() function copies an existing file to a new
+file. All file information like creation time and file attributes will
+be copied to the new file. However it will B<not> copy the security
+information. If the destination file already exists it will only be
+overwritten when the OVERWRITE parameter is true. But even this will
+not overwrite a read-only file; you have to unlink() it first
+yourself.
=item Win32::DomainName()
=item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE)
-[EXT] ]Looks up SID on SYSTEM and returns the account name, domain name,
+[EXT] Looks up SID on SYSTEM and returns the account name, domain name,
and the SID type.
=item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]])
perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
perlsyn perlop perlre perlrun perlfunc perlvar perlsub
- perlmod perlmodlib perlmodinstall perlform perllocale
+ perlmod perlmodlib perlmodinstall perlfork perlform perllocale
perlref perlreftut perldsc
perllol perltoot perltootc perlobj perltie perlbot perlipc
perldbmfilter perldebug
perltie Perl objects hidden behind simple variables
perlbot Perl OO tricks and examples
perlipc Perl interprocess communication
+ perlfork Perl fork() information
perlthrtut Perl threads tutorial
perldbmfilter Perl DBM Filters
=head1 HISTORY
-Written by Gurusamy Sarathy <F<gsar@umich.edu>>, with many contributions
+Written by Gurusamy Sarathy <F<gsar@activestate.com>>, with many contributions
from The Perl Porters.
Send omissions or corrections to <F<perlbug@perl.com>>.
=over 4
+=item STOP is a new keyword
+
+In addition to C<BEGIN>, C<INIT> and C<END>, subroutines named
+C<STOP> are now special. They are queued up for execution at the
+end of compilation, and cannot be called directly.
+
=item Treatment of list slices of undef has changed
When taking a slice of a literal list (as opposed to a slice of
has been removed, because it could potentially result in memory
leaks.
+=item Parenthesized not() behaves like a list operator
+
+The C<not> operator now falls under the "if it looks like a function,
+it behaves like a function" rule.
+
+As a result, the parenthesized form can be used with C<grep> and C<map>.
+The following construct used to be a syntax error before, but it works
+as expected now:
+
+ grep not($_), @things;
+
+On the other hand, using C<not> with a literal list slice may not
+work. The following previously allowed construct:
+
+ print not (1,2,3)[0];
+
+needs to be written with additional parentheses now:
+
+ print not((1,2,3)[0]);
+
+The behavior remains unaffected when C<not> is not followed by parentheses.
+
=back
=head2 C Source Incompatibilities
=item C<PERL_IMPLICIT_CONTEXT>
+PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built
+with one of -Dusethreads, -Dusemultiplicity, or both. It is not
+intended to be enabled by users at this time.
+
This new build option provides a set of macros for all API functions
such that an implicit interpreter/thread context argument is passed to
every API function. As a result of this, something like C<sv_setsv(foo,bar)>
Perl, whose interfaces continue to match those of prior versions
(but subject to the other options described here).
-PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built
-with one of -Dusethreads, -Dusemultiplicity, or both.
-
See L<perlguts/"The Perl API"> for detailed information on the
ramifications of building Perl using this option.
strings. The C<utf8> pragma enables this support in the current lexical
scope. See L<utf8> for more information.
+=head2 Interpreter threads
+
+WARNING: This is an experimental feature in a pre-alpha state. Use
+at your own risk.
+
+Perl 5.005_63 introduces the beginnings of support for running multiple
+interpreters concurrently in different threads. In conjunction with
+the perl_clone() API call, which can be used to selectively duplicate
+the state of any given interpreter, it is possible to compile a
+piece of code once in an interpreter, clone that interpreter
+one or more times, and run all the resulting interpreters in distinct
+threads.
+
+On Windows, this feature is used to emulate fork() at the interpreter
+level. See L<perlfork>.
+
+This feature is still in evolution. It is eventually meant to be used
+to selectively clone a subroutine and data reachable from that
+subroutine in a separate interpreter and run the cloned subroutine
+in a separate thread. Since there is no shared data between the
+interpreters, little or no locking will be needed (unless parts of
+the symbol table are explicitly shared). This is obviously intended
+to be an easy-to-use replacement for the existing threads support.
+
+Support for cloning interpreters must currently be manually enabled
+by defining the cpp macro USE_ITHREADS on non-Windows platforms.
+(See win32/Makefile for how to enable it on Windows.) The resulting
+perl executable will be functionally identical to one that was built
+without USE_ITHREADS, but the perl_clone() API call will only be
+available in the former.
+
+USE_ITHREADS enables Perl source code changes that provide a clear
+separation between the op tree and the data it operates with. The
+former is considered immutable, and can therefore be shared between
+an interpreter and all of its clones, while the latter is considered
+local to each interpreter, and is therefore copied for each clone.
+
+Note that building Perl with the -Dusemultiplicity Configure option
+is adequate if you wish to run multiple B<independent> interpreters
+concurrently in different threads. USE_ITHREADS only needs to be
+enabled if you wish to obtain access to perl_clone() and cloned
+interpreters.
+
+[XXX TODO - the Compiler backends may be broken when USE_ITHREADS is
+enabled.]
+
=head2 Lexically scoped warning categories
You can now control the granularity of warnings emitted by perl at a finer
WARNING: This is currently an experimental feature. Interfaces and
implementation are likely to change.
-Perl can be compiled with -DPERL_INTERNAL_GLOB to use the File::Glob
-implementation of the glob() operator. This avoids using an external
-csh process and the problems associated with it.
+Perl now uses the File::Glob implementation of the glob() operator
+automatically. This avoids using an external csh process and the
+problems associated with it.
=head2 Binary numbers supported
=head2 Filehandles can be autovivified
-The construct C<open(my $fh, ...)> can be used to create filehandles
-more easily. The filehandle will be automatically closed at the end
-of the scope of $fh, provided there are no other references to it. This
-largely eliminates the need for typeglobs when opening filehandles
-that must be passed around, as in the following example:
+Similar to how constructs such as C<$x->[0]> autovivify a reference,
+open() now autovivifies a filehandle if the first argument is an
+uninitialized variable. This allows the constructs C<open(my $fh, ...)> and
+C<open(local $fh,...)> to be used to create filehandles that will
+conveniently be closed automatically when the scope ends, provided there
+are no other references to them. This largely eliminates the need for
+typeglobs when opening filehandles that must be passed around, as in the
+following example:
sub myopen {
open my $fh, "@_"
You can Configure -Dusemorebits to turn on both the 64-bit support
and the long double support.
+=head2 Enhanced support for sort() subroutines
+
+Perl subroutines with a prototype of C<($$)> and XSUBs in general can
+now be used as sort subroutines. In either case, the two elements to
+be compared are passed as normal parameters in @_. See L<perlfunc/sort>.
+
+For unprototyped sort subroutines, the historical behavior of passing
+the elements to be compared as the global variables $a and $b remains
+unchanged.
+
=head2 Better syntax checks on parenthesized unary operators
Expressions such as:
enables perl code to determine whether actions that make sense
only during normal running are warranted. See L<perlvar>.
+=head2 STOP blocks
+
+Arbitrary code can be queued for execution when Perl has finished
+parsing the program (i.e. when the compile phase ends) using STOP
+blocks. These behave similar to END blocks, except for being
+called at the end of compilation rather than at the end of execution.
+
=head2 Optional Y2K warnings
If Perl is built with the cpp macro C<PERL_Y2KWARN> defined,
behavior, END blocks are not executed anymore when the C<-c> switch
is used.
-Note that something resembling the previous behavior can still be
-obtained by putting C<BEGIN { $^C = 0; exit; }> at the very end of
-the top level source file.
+See L<STOP blocks> for how to run things when the compile phase ends.
=head2 Potential to leak DATA filehandles
=head2 DOS
-[TODO - Laszlo Molnar <laszlo.molnar@eth.ericsson.se>]
+=over 4
+
+=item *
+
+Perl now works with djgpp 2.02 (and 2.03 alpha).
+
+=item *
+
+Environment variable names are not converted to uppercase any more.
+
+=item *
+
+Wrong exit code from backticks now fixed.
+
+=item *
+
+This port is still using its own builtin globbing.
+
+=back
=head2 OS/2
A bug that caused File::Find to lose track of the working directory
when pruning top-level directories has been fixed.
+File::Find now also supports several other options to control its
+behavior. It can follow symbolic links if the C<follow> option is
+specified. Enabling the C<no_chdir> option will make File::Find skip
+changing the current directory when walking directories. The C<untaint>
+flag can be useful when running with taint checks enabled.
+
+See L<File::Find>.
+
=item File::Glob
-This extension implements BSD-style file globbing. It will also be
-used for the internal implementation of the glob() operator if
-Perl was compiled with -DPERL_INTERNAL_GLOB. See L<File::Glob>.
+This extension implements BSD-style file globbing. By default,
+it will also be used for the internal implementation of the glob()
+operator. See L<File::Glob>.
=item File::Spec
(F) A subroutine invoked from an external package via perl_call_sv()
exited by calling exit.
-=item Can't "goto" outside a block
+=item Can't "goto" out of a pseudo block
(F) A "goto" statement was executed to jump out of what might look
like a block, except that it isn't a proper block. This usually
(F) A "goto" statement was executed to jump into the middle of a
foreach loop. You can't get there from here. See L<perlfunc/goto>.
-=item Can't "last" outside a block
+=item Can't "last" outside a loop block
(F) A "last" statement was executed to break out of the current block,
except that there's this itty bitty problem called there isn't a
current block. Note that an "if" or "else" block doesn't count as a
-"loopish" block, as doesn't a block given to sort(). You can usually double
-the curlies to get the same effect though, because the inner curlies
-will be considered a block that loops once. See L<perlfunc/last>.
+"loopish" block, as doesn't a block given to sort(), map() or grep().
+You can usually double the curlies to get the same effect though,
+because the inner curlies will be considered a block that loops once.
+See L<perlfunc/last>.
-=item Can't "next" outside a block
+=item Can't "next" outside a loop block
(F) A "next" statement was executed to reiterate the current block, but
there isn't a current block. Note that an "if" or "else" block doesn't
-count as a "loopish" block, as doesn't a block given to sort(). You can
-usually double the curlies to get the same effect though, because the inner
-curlies will be considered a block that loops once. See L<perlfunc/next>.
+count as a "loopish" block, as doesn't a block given to sort(), map()
+or grep(). You can usually double the curlies to get the same effect
+though, because the inner curlies will be considered a block that
+loops once. See L<perlfunc/next>.
=item Can't read CRTL environ
missing. You need to figure out where your CRTL misplaced its environ
or define F<PERL_ENV_TABLES> (see L<perlvms>) so that environ is not searched.
-=item Can't "redo" outside a block
+=item Can't "redo" outside a loop block
(F) A "redo" statement was executed to restart the current block, but
there isn't a current block. Note that an "if" or "else" block doesn't
-count as a "loopish" block, as doesn't a block given to sort(). You can
-usually double the curlies to get the same effect though, because the inner
-curlies will be considered a block that loops once. See L<perlfunc/redo>.
+count as a "loopish" block, as doesn't a block given to sort(), map()
+or grep(). You can usually double the curlies to get the same effect
+though, because the inner curlies will be considered a block that
+loops once. See L<perlfunc/redo>.
=item Can't bless non-reference value
(F) You called C<perl -x/foo/bar>, but C</foo/bar> is not a directory
that you can chdir to, possibly because it doesn't exist.
-=item Can't check filesystem of script "%s"
+=item Can't check filesystem of script "%s" for nosuid
(P) For some reason you can't check the filesystem of the script for nosuid.
named "elseif" for the class returned by the following block. This is
unlikely to be what you want.
-=item END failed--cleanup aborted
+=item %s failed--call queue aborted
-(F) An untrapped exception was raised while executing an END subroutine.
-The interpreter is immediately exited.
+(F) An untrapped exception was raised while executing a STOP, INIT, or
+END subroutine. Processing of the remainder of the queue of such
+routines has been prematurely ended.
=item entering effective %s failed
(P) The lexer got into a bad state while processing a case modifier.
+=item panic: %s
+
+(P) An internal error.
+
=item Parentheses missing around "%s" list
(W) You said something like
because there's a better way to do it, and also because the old way has
bad side effects.
-=item Use of uninitialized value
+=item Use of uninitialized value%s
(W) An undefined value was used as if it were already defined. It was
interpreted as a "" or a 0, but maybe it was a mistake. To suppress this
Most of the major modules (Tk, CGI, libwww-perl) have their own
mailing lists. Consult the documentation that came with the module for
-subscription information. The Perl Institute attempts to maintain a
+subscription information. Perl Mongers attempts to maintain a
list of mailing lists at:
- http://www.perl.org/maillist.html
+ http://www.perl.org/support/online_support.html#mail
=head2 Archives of comp.lang.perl.misc
}
}
- sub is_numeric { defined &getnum }
+ sub is_numeric { defined getnum($_[0]) }
Or you could check out
http://www.perl.com/CPAN/modules/by-module/String/String-Scanf-1.1.tar.gz
=head2 How do I remove HTML from a string?
The most correct way (albeit not the fastest) is to use HTML::Parser
-from CPAN (part of the HTML-Tree package on CPAN).
+from CPAN (part of the HTML-Tree package on CPAN). Another correct
+way is to use HTML::FormatText which not only removes HTML but also
+attempts to do a little simple formatting of the resulting plain text.
Many folks attempt a simple-minded regular expression approach, like
C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags
--- /dev/null
+=head1 NAME
+
+perlfork - Perl's fork() emulation
+
+=head1 SYNOPSIS
+
+Perl provides a fork() keyword that corresponds to the Unix system call
+of the same name. On most Unix-like platforms where the fork() system
+call is available, Perl's fork() simply calls it.
+
+On some platforms such as Windows where the fork() system call is not
+available, Perl can be built to emulate fork() at the interpreter level.
+While the emulation is designed to be as compatible as possible with the
+real fork() at the the level of the Perl program, there are certain
+important differences that stem from the fact that all the pseudo child
+"processes" created this way live in the same real process as far as the
+operating system is concerned.
+
+This document provides a general overview of the capabilities and
+limitations of the fork() emulation. Note that the issues discussed here
+are not applicable to platforms where a real fork() is available and Perl
+has been configured to use it.
+
+=head1 DESCRIPTION
+
+The fork() emulation is implemented at the level of the Perl interpreter.
+What this means in general is that running fork() will actually clone the
+running interpreter and all its state, and run the cloned interpreter in
+a separate thread, beginning execution in the new thread just after the
+point where the fork() was called in the parent. We will refer to the
+thread that implements this child "process" as the pseudo-process.
+
+To the Perl program that called fork(), all this is designed to be
+transparent. The parent returns from the fork() with a pseudo-process
+ID that can be subsequently used in any process manipulation functions;
+the child returns from the fork() with a value of C<0> to signify that
+it is the child pseudo-process.
+
+=head2 Behavior of other Perl features in forked pseudo-processes
+
+Most Perl features behave in a natural way within pseudo-processes.
+
+=over 8
+
+=item $$ or $PROCESS_ID
+
+This special variable is correctly set to the pseudo-process ID.
+It can be used to identify pseudo-processes within a particular
+session. Note that this value is subject to recycling if any
+pseudo-processes are launched after others have been wait()-ed on.
+
+=item %ENV
+
+Each pseudo-process maintains its own virtual enviroment. Modifications
+to %ENV affect the virtual environment, and are only visible within that
+pseudo-process, and in any processes (or pseudo-processes) launched from
+it.
+
+=item chdir() and all other builtins that accept filenames
+
+Each pseudo-process maintains its own virtual idea of the current directory.
+Modifications to the current directory using chdir() are only visible within
+that pseudo-process, and in any processes (or pseudo-processes) launched from
+it. All file and directory accesses from the pseudo-process will correctly
+map the virtual working directory to the real working directory appropriately.
+
+=item wait() and waitpid()
+
+wait() and waitpid() can be passed a pseudo-process ID returned by fork().
+These calls will properly wait for the termination of the pseudo-process
+and return its status.
+
+=item kill()
+
+kill() can be used to terminate a pseudo-process by passing it the ID returned
+by fork(). This should not be used except under dire circumstances, because
+the operating system may not guarantee integrity of the process resources
+when a running thread is terminated. Note that using kill() on a
+pseudo-process() may typically cause memory leaks, because the thread that
+implements the pseudo-process does not get a chance to clean up its resources.
+
+=item exec()
+
+Calling exec() within a pseudo-process actually spawns the requested
+executable in a separate process and waits for it to complete before
+exiting with the same exit status as that process. This means that the
+process ID reported within the running executable will be different from
+what the earlier Perl fork() might have returned. Similarly, any process
+manipulation functions applied to the ID returned by fork() will affect the
+waiting pseudo-process that called exec(), not the real process it is
+waiting for after the exec().
+
+=item exit()
+
+exit() always exits just the executing pseudo-process, after automatically
+wait()-ing for any outstanding child pseudo-processes. Note that this means
+that the process as a whole will not exit unless all running pseudo-processes
+have exited.
+
+=item Open handles to files, directories and network sockets
+
+All open handles are dup()-ed in pseudo-processes, so that closing
+any handles in one process does not affect the others. See below for
+some limitations.
+
+=back
+
+=head2 Resource limits
+
+In the eyes of the operating system, pseudo-processes created via the fork()
+emulation are simply threads in the same process. This means that any
+process-level limits imposed by the operating system apply to all
+pseudo-processes taken together. This includes any limits imposed by the
+operating system on the number of open file, directory and socket handles,
+limits on disk space usage, limits on memory size, limits on CPU utilization
+etc.
+
+=head2 Killing the parent process
+
+If the parent process is killed (either using Perl's kill() builtin, or
+using some external means) all the pseudo-processes are killed as well,
+and the whole process exits.
+
+=head2 Lifetime of the parent process and pseudo-processes
+
+During the normal course of events, the parent process and every
+pseudo-process started by it will wait for their respective pseudo-children
+to complete before they exit. This means that the parent and every
+pseudo-child created by it that is also a pseudo-parent will only exit
+after their pseudo-children have exited.
+
+A way to mark a pseudo-processes as running detached from their parent (so
+that the parent would not have to wait() for them if it doesn't want to)
+will be provided in future.
+
+=head2 CAVEATS AND LIMITATIONS
+
+=over 8
+
+=item BEGIN blocks
+
+The fork() emulation will not work entirely correctly when called from
+within a BEGIN block. The forked copy will run the contents of the
+BEGIN block, but will not continue parsing the source stream after the
+BEGIN block. For example, consider the following code:
+
+ BEGIN {
+ fork and exit; # fork child and exit the parent
+ print "inner\n";
+ }
+ print "outer\n";
+
+This will print:
+
+ inner
+
+rather than the expected:
+
+ inner
+ outer
+
+This limitation arises from fundamental technical difficulties in
+cloning and restarting the stacks used by the Perl parser in the
+middle of a parse.
+
+=item Open filehandles
+
+Any filehandles open at the time of the fork() will be dup()-ed. Thus,
+the files can be closed independently in the parent and child, but beware
+that the dup()-ed handles will still share the same seek pointer. Changing
+the seek position in the parent will change it in the child and vice-versa.
+One can avoid this by opening files that need distinct seek pointers
+separately in the child.
+
+=item Global state maintained by XSUBs
+
+External subroutines (XSUBs) that maintain their own global state may
+not work correctly. Such XSUBs will either need to maintain locks to
+protect simultaneous access to global data from different pseudo-processes,
+or maintain all their state on the Perl symbol table, which is copied
+naturally when fork() is called. A callback mechanism that provides
+extensions an opportunity to clone their state will be provided in the
+near future.
+
+=item Interpreter embedded in larger application
+
+The fork() emulation may not behave as expected when it is executed in an
+application which embeds a Perl interpreter and calls Perl APIs that can
+evaluate bits of Perl code. This stems from the fact that the emulation
+only has knowledge about the Perl interpreter's own data structures and
+knows nothing about the containing application's state. For example, any
+state carried on the application's own call stack is out of reach.
+
+=item Thread-safety of extensions
+
+Since the fork() emulation runs code in multiple threads, extensions
+calling into non-thread-safe libraries may not work reliably when
+calling fork(). As Perl's threading support gradually becomes more
+widely adopted even on platforms with a native fork(), such extensions
+are expected to be fixed for thread-safety.
+
+=back
+
+=head1 BUGS
+
+=over 8
+
+=item *
+
+Having pseudo-process IDs be negative integers breaks down for the integer
+C<-1> because the wait() and waitpid() functions treat this number as
+being special. The tacit assumption in the current implementation is that
+the system never allocates a thread ID of C<1> for user threads. A better
+representation for pseudo-process IDs will be implemented in future.
+
+=item *
+
+This document may be incomplete in some respects.
+
+=head1 AUTHOR
+
+Support for concurrent interpreters and the fork() emulation was implemented
+by ActiveState, with funding from Microsoft Corporation.
+
+This document is authored and maintained by Gurusamy Sarathy
+E<lt>gsar@activestate.comE<gt>.
+
+=head1 SEE ALSO
+
+L<perlfunc/"fork">, L<perlipc>
+
+=cut
($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints) = caller($i);
-Here $subroutine may be C<"(eval)"> if the frame is not a subroutine
+Here $subroutine may be C<(eval)> if the frame is not a subroutine
call, but an C<eval>. In such a case additional elements $evaltext and
C<$is_require> are set: C<$is_require> is true if the frame is created by a
C<require> or C<use> statement, $evaltext contains the text of the
C<eval EXPR> statement. In particular, for a C<eval BLOCK> statement,
-$filename is C<"(eval)">, but $evaltext is undefined. (Note also that
+$filename is C<(eval)>, but $evaltext is undefined. (Note also that
each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
frame. C<$hints> contains pragmatic hints that the caller was
compiled with. It currently only reflects the hint corresponding to
This function works like the system call by the same name: it makes the
named directory the new root directory for all further pathnames that
-begin with a C<"/"> by your process and all its children. (It doesn't
+begin with a C</> by your process and all its children. (It doesn't
change your current working directory, which is unaffected.) For security
reasons, this call is restricted to the superuser. If FILENAME is
omitted, does a C<chroot> to C<$_>.
}
Practical hint: you almost never need to use C<eof> in Perl, because the
-input operators return false values when they run out of data, or if there
-was an error.
+input operators typically return C<undef> when they run out of data, or if
+there was an error.
=item eval EXPR
or die "can't fcntl F_GETFL: $!";
You don't have to check for C<defined> on the return from C<fnctl>.
-Like C<ioctl>, it maps a C<0> return from the system call into C<"0
-but true"> in Perl. This string is true in boolean context and C<0>
+Like C<ioctl>, it maps a C<0> return from the system call into
+C<"0 but true"> in Perl. This string is true in boolean context and C<0>
in numeric context. It is also exempt from the normal B<-w> warnings
on improper numeric conversions.
goto ("FOO", "BAR", "GLARCH")[$i];
-The C<goto-&NAME> form is highly magical, and substitutes a call to the
-named subroutine for the currently running subroutine. This is used by
-C<AUTOLOAD> subroutines that wish to load another subroutine and then
-pretend that the other subroutine had been called in the first place
-(except that any modifications to C<@_> in the current subroutine are
-propagated to the other subroutine.) After the C<goto>, not even C<caller>
-will be able to tell that this routine was called first.
+The C<goto-&NAME> form is quite different from the other forms of C<goto>.
+In fact, it isn't a goto in the normal sense at all, and doesn't have
+the stigma associated with other gotos. Instead, it
+substitutes a call to the named subroutine for the currently running
+subroutine. This is used by C<AUTOLOAD> subroutines that wish to load
+another subroutine and then pretend that the other subroutine had been
+called in the first place (except that any modifications to C<@_>
+in the current subroutine are propagated to the other subroutine.)
+After the C<goto>, not even C<caller> will be able to tell that this
+routine was called first.
+
+NAME needn't be the name of a subroutine; it can be a scalar variable
+containing a code reference, or a block which evaluates to a code
+reference.
=item grep BLOCK LIST
first to get the correct constant definitions. If CMD is C<IPC_STAT>,
then ARG must be a variable which will hold the returned C<msqid_ds>
-structure. Returns like C<ioctl>: the undefined value for error, C<"0 but
-true"> for zero, or the actual return value otherwise. See also
+structure. Returns like C<ioctl>: the undefined value for error,
+C<"0 but true"> for zero, or the actual return value otherwise. See also
C<IPC::SysV> and C<IPC::Semaphore> documentation.
=item msgget KEY,FLAGS
open(FILEHANDLE, "<&=$fd")
+Note that this feature depends on the fdopen() C library function.
+On many UNIX systems, fdopen() is known to fail when file descriptors
+exceed a certain value, typically 255. If you need more file
+descriptors than that, consider rebuilding Perl to use the C<sfio>
+library.
+
If you open a pipe on the command C<'-'>, i.e., either C<'|-'> or C<'-|'>
with 2-arguments (or 1-argument) form of open(), then
there is an implicit fork done, and the return value of open is the pid
what a local C compiler calls 'long'. If you want
native-length longs, use the '!' suffix.)
- n A short in "network" (big-endian) order.
- N A long in "network" (big-endian) order.
- v A short in "VAX" (little-endian) order.
- V A long in "VAX" (little-endian) order.
+ n An unsigned short in "network" (big-endian) order.
+ N An unsigned long in "network" (big-endian) order.
+ v An unsigned short in "VAX" (little-endian) order.
+ V An unsigned long in "VAX" (little-endian) order.
(These 'shorts' and 'longs' are _exactly_ 16 bits and
_exactly_ 32 bits, respectively.)
=item *
Each letter may optionally be followed by a number giving a repeat
-count. With all types except C<"a">, C<"A">, C<"Z">, C<"b">, C<"B">, C<"h">,
-C<"H">, and C<"P"> the pack function will gobble up that many values from
+count. With all types except C<a>, C<A>, C<Z>, C<b>, C<B>, C<h>,
+C<H>, and C<P> the pack function will gobble up that many values from
the LIST. A C<*> for the repeat count means to use however many items are
-left, except for C<"@">, C<"x">, C<"X">, where it is equivalent
-to C<"0">, and C<"u">, where it is equivalent to 1 (or 45, what is the
+left, except for C<@>, C<x>, C<X>, where it is equivalent
+to C<0>, and C<u>, where it is equivalent to 1 (or 45, what is the
same).
-When used with C<"Z">, C<*> results in the addition of a trailing null
+When used with C<Z>, C<*> results in the addition of a trailing null
byte (so the packed result will be one longer than the byte C<length>
of the item).
-The repeat count for C<"u"> is interpreted as the maximal number of bytes
+The repeat count for C<u> is interpreted as the maximal number of bytes
to encode per line of output, with 0 and 1 replaced by 45.
=item *
-The C<"a">, C<"A">, and C<"Z"> types gobble just one value, but pack it as a
+The C<a>, C<A>, and C<Z> types gobble just one value, but pack it as a
string of length count, padding with nulls or spaces as necessary. When
-unpacking, C<"A"> strips trailing spaces and nulls, C<"Z"> strips everything
-after the first null, and C<"a"> returns data verbatim. When packing,
-C<"a">, and C<"Z"> are equivalent.
+unpacking, C<A> strips trailing spaces and nulls, C<Z> strips everything
+after the first null, and C<a> returns data verbatim. When packing,
+C<a>, and C<Z> are equivalent.
If the value-to-pack is too long, it is truncated. If too long and an
-explicit count is provided, C<"Z"> packs only C<$count-1> bytes, followed
-by a null byte. Thus C<"Z"> always packs a trailing null byte under
+explicit count is provided, C<Z> packs only C<$count-1> bytes, followed
+by a null byte. Thus C<Z> always packs a trailing null byte under
all circumstances.
=item *
-Likewise, the C<"b"> and C<"B"> fields pack a string that many bits long.
-Each byte of the input field generates 1 bit of the result basing on
-the least-signifant bit of each input byte, i.e., on C<ord($byte)%2>.
-In particular, bytes C<"0"> and C<"1"> generate bits 0 and 1.
+Likewise, the C<b> and C<B> fields pack a string that many bits long.
+Each byte of the input field of pack() generates 1 bit of the result.
+Each result bit is based on the least-significant bit of the corresponding
+input byte, i.e., on C<ord($byte)%2>. In particular, bytes C<"0"> and
+C<"1"> generate bits 0 and 1, as do bytes C<"\0"> and C<"\1">.
+
+Starting from the beginning of the input string of pack(), each 8-tuple
+of bytes is converted to 1 byte of output. With format C<b>
+the first byte of the 8-tuple determines the least-significant bit of a
+byte, and with format C<B> it determines the most-significant bit of
+a byte.
-Starting from the beginning of the input string, each 8-tuple of bytes
-is converted to 1 byte of output. If the length of the input string
-is not divisible by 8, the remainder is packed as if padded by 0s.
-Similarly, during unpack()ing the "extra" bits are ignored.
+If the length of the input string is not exactly divisible by 8, the
+remainder is packed as if the input string were padded by null bytes
+at the end. Similarly, during unpack()ing the "extra" bits are ignored.
-If the input string is longer than needed, extra bytes are ignored.
+If the input string of pack() is longer than needed, extra bytes are ignored.
A C<*> for the repeat count of pack() means to use all the bytes of
the input field. On unpack()ing the bits are converted to a string
of C<"0">s and C<"1">s.
=item *
-The C<"h"> and C<"H"> fields pack a string that many nybbles (4-bit groups,
+The C<h> and C<H> fields pack a string that many nybbles (4-bit groups,
representable as hexadecimal digits, 0-9a-f) long.
+Each byte of the input field of pack() generates 4 bits of the result.
+For non-alphabetical bytes the result is based on the 4 least-significant
+bits of the input byte, i.e., on C<ord($byte)%16>. In particular,
+bytes C<"0"> and C<"1"> generate nybbles 0 and 1, as do bytes
+C<"\0"> and C<"\1">. For bytes C<"a".."f"> and C<"A".."F"> the result
+is compatible with the usual hexadecimal digits, so that C<"a"> and
+C<"A"> both generate the nybble C<0xa==10>. The result for bytes
+C<"g".."z"> and C<"G".."Z"> is not well-defined.
+
+Starting from the beginning of the input string of pack(), each pair
+of bytes is converted to 1 byte of output. With format C<h> the
+first byte of the pair determines the least-significant nybble of the
+output byte, and with format C<H> it determines the most-significant
+nybble.
+
+If the length of the input string is not even, it behaves as if padded
+by a null byte at the end. Similarly, during unpack()ing the "extra"
+nybbles are ignored.
+
+If the input string of pack() is longer than needed, extra bytes are ignored.
+A C<*> for the repeat count of pack() means to use all the bytes of
+the input field. On unpack()ing the bits are converted to a string
+of hexadecimal digits.
+
=item *
-The C<"p"> type packs a pointer to a null-terminated string. You are
+The C<p> type packs a pointer to a null-terminated string. You are
responsible for ensuring the string is not a temporary value (which can
potentially get deallocated before you get around to using the packed result).
-The C<"P"> type packs a pointer to a structure of the size indicated by the
-length. A NULL pointer is created if the corresponding value for C<"p"> or
-C<"P"> is C<undef>, similarly for unpack().
+The C<P> type packs a pointer to a structure of the size indicated by the
+length. A NULL pointer is created if the corresponding value for C<p> or
+C<P> is C<undef>, similarly for unpack().
=item *
-The C<"/"> character allows packing and unpacking of strings where the
-packed structure contains a byte count followed by the string itself.
+The C</> template character allows packing and unpacking of strings where
+the packed structure contains a byte count followed by the string itself.
You write I<length-item>C</>I<string-item>.
The I<length-item> can be any C<pack> template letter,
and describes how the length value is packed.
The ones likely to be of most use are integer-packing ones like
-C<"n"> (for Java strings), C<"w"> (for ASN.1 or SNMP)
-and C<"N"> (for Sun XDR).
+C<n> (for Java strings), C<w> (for ASN.1 or SNMP)
+and C<N> (for Sun XDR).
The I<string-item> must, at present, be C<"A*">, C<"a*"> or C<"Z*">.
For C<unpack> the length of the string is obtained from the I<length-item>,
The I<length-item> is not returned explicitly from C<unpack>.
-Adding a count to the I<length-item> letter
-is unlikely to do anything useful,
-unless that letter is C<"A">, C<"a"> or C<"Z">.
-Packing with a I<length-item> of C<"a"> or C<"Z">
-may introduce C<"\000"> characters,
+Adding a count to the I<length-item> letter is unlikely to do anything
+useful, unless that letter is C<A>, C<a> or C<Z>. Packing with a
+I<length-item> of C<a> or C<Z> may introduce C<"\000"> characters,
which Perl does not regard as legal in numeric strings.
=item *
-The integer types C<"s">, C<"S">, C<"l">, and C<"L"> may be
-immediately followed by a C<"!"> suffix to signify native shorts or
-longs--as you can see from above for example a bare C<"l"> does mean
+The integer types C<s>, C<S>, C<l>, and C<L> may be
+immediately followed by a C<!> suffix to signify native shorts or
+longs--as you can see from above for example a bare C<l> does mean
exactly 32 bits, the native C<long> (as seen by the local C compiler)
may be larger. This is an issue mainly in 64-bit platforms. You can
-see whether using C<"!"> makes any difference by
+see whether using C<!> makes any difference by
print length(pack("s")), " ", length(pack("s!")), "\n";
print length(pack("l")), " ", length(pack("l!")), "\n";
-C<"i!"> and C<"I!"> also work but only because of completeness;
-they are identical to C<"i"> and C<"I">.
+C<i!> and C<I!> also work but only because of completeness;
+they are identical to C<i> and C<I>.
The actual sizes (in bytes) of native shorts, ints, longs, and long
longs on the platform where Perl was built are also available via
=item *
-The integer formats C<"s">, C<"S">, C<"i">, C<"I">, C<"l">, and C<"L">
+The integer formats C<s>, C<S>, C<i>, C<I>, C<l>, and C<L>
are inherently non-portable between processors and operating systems
because they obey the native byteorder and endianness. For example a
4-byte integer 0x12345678 (305419896 decimal) be ordered natively
0x12 0x34 0x56 0x78 # little-endian
0x78 0x56 0x34 0x12 # big-endian
-Basically, the Intel, Alpha, and VAX CPUs and little-endian, while
+Basically, the Intel, Alpha, and VAX CPUs are little-endian, while
everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA,
Power, and Cray are big-endian. MIPS can be either: Digital used it
in little-endian mode; SGI uses it in big-endian mode.
Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'>
and C<'87654321'> are big-endian.
-If you want portable packed integers use the formats C<"n">, C<"N">,
-C<"v">, and C<"V">, their byte endianness and size is known.
+If you want portable packed integers use the formats C<n>, C<N>,
+C<v>, and C<V>, their byte endianness and size is known.
See also L<perlport>.
=item *
foreach $prefix (@INC) {
$realfilename = "$prefix/$filename";
if (-f $realfilename) {
+ $INC{$filename} = $realfilename;
$result = do $realfilename;
last ITER;
}
}
die "Can't find $filename in \@INC";
}
+ delete $INC{$filename} if $@ || !$result;
die $@ if $@;
die "$filename did not return true value" unless $result;
- $INC{$filename} = $realfilename;
return $result;
}
array, returns the undefined value. If ARRAY is omitted, shifts the
C<@_> array within the lexical scope of subroutines and formats, and the
C<@ARGV> array at file scopes or within the lexical scopes established by
-the C<eval ''>, C<BEGIN {}>, C<END {}>, and C<INIT {}> constructs.
+the C<eval ''>, C<BEGIN {}>, C<INIT {}>, C<STOP {}>, and C<END {}>
+constructs.
+
See also C<unshift>, C<push>, and C<pop>. C<Shift()> and C<unshift> do the
same thing to the left end of an array that C<pop> and C<push> do to the
right end.
of a SUBNAME, you can provide a BLOCK as an anonymous, in-line sort
subroutine.
-In the interests of efficiency the normal calling code for subroutines is
-bypassed, with the following effects: the subroutine may not be a
-recursive subroutine, and the two elements to be compared are passed into
-the subroutine not via C<@_> but as the package global variables $a and
-$b (see example below). They are passed by reference, so don't
-modify $a and $b. And don't try to declare them as lexicals either.
+If the subroutine's prototype is C<($$)>, the elements to be compared
+are passed by reference in C<@_>, as for a normal subroutine. If not,
+the normal calling code for subroutines is bypassed in the interests of
+efficiency, and the elements to be compared are passed into the subroutine
+as the package global variables $a and $b (see example below). Note that
+in the latter case, it is usually counter-productive to declare $a and
+$b as lexicals.
+
+In either case, the subroutine may not be recursive. The values to be
+compared are always passed by reference, so don't modify them.
You also cannot exit out of the sort block or subroutine using any of the
loop control operators described in L<perlsyn> or with C<goto>.
||
$a->[2] cmp $b->[2]
} map { [$_, /=(\d+)/, uc($_)] } @old;
+
+ # using a prototype allows you to use any comparison subroutine
+ # as a sort subroutine (including other package's subroutines)
+ package other;
+ sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
+
+ package main;
+ @new = sort other::backwards @old;
If you're using strict, you I<must not> declare $a
and $b as lexicals. They are package globals. That means
point in formatted real numbers is affected by the LC_NUMERIC locale.
See L<perllocale>.
-To cope with broken systems that allow the standard locales to be
-overridden by malicious users, the return value may be tainted
-if any of the floating point formats are used and the conversion
-yields something that doesn't look like a normal C-locale floating
-point number. This happens regardless of whether C<use locale> is
-in effect or not.
-
If Perl understands "quads" (64-bit integers) (this requires
either that the platform natively supports quads or that Perl
has been specifically compiled to support quads), the characters
print;
}
-In searching for C</\bfoo\b/>, only those locations in C<$_> that contain C<"f">
-will be looked at, because C<"f"> is rarer than C<"o">. In general, this is
+In searching for C</\bfoo\b/>, only those locations in C<$_> that contain C<f>
+will be looked at, because C<f> is rarer than C<o>. In general, this is
a big win except in pathological cases. The only question is whether
it saves you more time than it took to build the linked list in the
first place.
supported by perl: zero means read-only, one means write-only, and two
means read/write. We know that these values do I<not> work under
OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to
-se them in new code, use thhe constants discussed in the preceding
-paragraph.
+use them in new code.
If the file named by FILENAME does not exist and the C<open> call creates
it (typically because MODE includes the C<O_CREAT> flag), then the value of
Better to omit it. See the perlfunc(1) entry on C<umask> for more
on this.
+Note that C<sysopen> depends on the fdopen() C library function.
+On many UNIX systems, fdopen() is known to fail when file descriptors
+exceed a certain value, typically 255. If you need more file
+descriptors than that, consider rebuilding Perl to use the C<sfio>
+library, or perhaps using the POSIX::open() function.
+
See L<perlopentut> for a kinder, gentler explanation of opening files.
=item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
$setbits = unpack("%32b*", $selectmask);
-The C<"p"> and C<"P"> formats should be used with care. Since Perl
+The C<p> and C<P> formats should be used with care. Since Perl
has no way of checking whether the value passed to C<unpack()>
corresponds to a valid memory location, passing a pointer value that's
not known to be valid is likely to have disastrous consequences.
be a power of two from 1 to 32 (or 64, if your platform supports
that).
+If BITS is 8, "elements" coincide with bytes of the input string.
+
+If BITS is 16 or more, bytes of the input string are grouped into chunks
+of size BITS/8, and each group is converted to a number as with
+pack()/unpack() with big-endian formats C<n>/C<N> (and analoguously
+for BITS==64). See L<"pack"> for details.
+
+If bits is 4 or less, the string is broken into bytes, then the bits
+of each byte are broken into 8/BITS groups. Bits of a byte are
+numbered in a little-endian-ish way, as in C<0x01>, C<0x02>,
+C<0x04>, C<0x08>, C<0x10>, C<0x20>, C<0x40>, C<0x80>. For example,
+breaking the single input byte C<chr(0x36)> into two groups gives a list
+C<(0x6, 0x3)>; breaking it into 4 groups gives C<(0x2, 0x1, 0x3, 0x0)>.
+
C<vec> may also be assigned to, in which case parentheses are needed
to give the expression the correct precedence as in
words, it's your usual mix of technical people.
Over this group of porters presides Larry Wall. He has the final word
-in what does and does not change in the Perl language. Various releases
-of Perl are shepherded by a ``pumpking'', a porter responsible for
-gathering patches, deciding on a patch-by-patch feature-by-feature
-basis what will and will not go into the release. For instance,
-Gurusamy Sarathy is the pumpking for the 5.6 release of Perl.
+in what does and does not change in the Perl language. Various
+releases of Perl are shepherded by a ``pumpking'', a porter
+responsible for gathering patches, deciding on a patch-by-patch
+feature-by-feature basis what will and will not go into the release.
+For instance, Gurusamy Sarathy is the pumpking for the 5.6 release of
+Perl.
In addition, various people are pumpkings for different things. For
instance, Andy Dougherty and Jarkko Hietaniemi share the I<Configure>
Work for the pumpking, work for Perl programmers, work for module
authors, ... Perl is supposed to be easy.
+=item Patches speak louder than words
+
+Working code is always preferred to pie-in-the-sky ideas. A patch to
+add a feature stands a much higher chance of making it to the language
+than does a random feature request, no matter how fervently argued the
+request might be. This ties into ``Will it be useful?'', as the fact
+that someone took the time to make the patch demonstrates a strong
+desire for the feature.
+
=back
If you're on the list, you might hear the word ``core'' bandied
Always submit patches to I<perl5-porters@perl.org>. This lets other
porters review your patch, which catches a surprising number of errors
-in patches. Either use the diff program (available in source code form
-from I<ftp://ftp.gnu.org/pub/gnu/>), or use Johan Vromans' I<makepatch>
-(available from I<CPAN/authors/id/JV/>). Unified diffs are preferred,
-but context diffs are ok too. Do not send RCS-style diffs or diffs
-without context lines. More information is given in the
-I<Porting/patching.pod> file in the Perl source distribution. Please
-patch against the latest B<development> version (e.g., if you're fixing
-a bug in the 5.005 track, patch against the latest 5.005_5x version).
-Only patches that survive the heat of the development branch get
-applied to maintenance versions.
+in patches. Either use the diff program (available in source code
+form from I<ftp://ftp.gnu.org/pub/gnu/>), or use Johan Vromans'
+I<makepatch> (available from I<CPAN/authors/id/JV/>). Unified diffs
+are preferred, but context diffs are accepted. Do not send RCS-style
+diffs or diffs without context lines. More information is given in
+the I<Porting/patching.pod> file in the Perl source distribution.
+Please patch against the latest B<development> version (e.g., if
+you're fixing a bug in the 5.005 track, patch against the latest
+5.005_5x version). Only patches that survive the heat of the
+development branch get applied to maintenance versions.
Your patch should update the documentation and test suite.
The CPAN testers (I<http://testers.cpan.org/>) are a group of
volunteers who test CPAN modules on a variety of platforms. Perl Labs
-(I<http://labs.perl.org/>) automatically tests modules and Perl source
-releases on platforms and gives feedback to the CPAN testers mailing
-list. Both efforts welcome volunteers.
+(I<http://labs.perl.org/>) automatically tests Perl source releases on
+platforms and gives feedback to the CPAN testers mailing list. Both
+efforts welcome volunteers.
To become an active and patching Perl porter, you'll need to learn how
Perl works on the inside. Chip Salzenberg, a pumpking, has written
interpreter work. The C<perlguts> manpage explains the internal data
structures. And, of course, the C source code (sometimes sparsely
commented, sometimes commented well) is a great place to start (begin
-with C<perl.c> and see where it goes from there). A lot of the
-style of the Perl source is explained in the I<Porting/pumpkin.pod>
-file in the source distribution.
+with C<perl.c> and see where it goes from there). A lot of the style
+of the Perl source is explained in the I<Porting/pumpkin.pod> file in
+the source distribution.
It is essential that you be comfortable using a good debugger
(e.g. gdb, dbx) before you can patch perl. Stepping through perl
a useful contribution when do you speak up.
If after all this you still think you want to join the perl5-porters
-mailing list, send mail to I<perl5-porters-request@perl.org> with the
-body of your message reading I<subscribe>. To unsubscribe, either
-send mail to the same address with the body reading I<unsubscribe>, or
-send mail to I<perl5-porters-unsubscribe@perl.org>.
+mailing list, send mail to I<perl5-porters-subscribe@perl.org>. To
+unsubscribe, send mail to I<perl5-porters-unsubscribe@perl.org>.
=head1 AUTHOR
This document was written by Nathan Torkington, and is maintained by
the perl5-porters mailing list.
-=cut
};
if ($@ and $@ !~ /alarm clock restart/) { die }
+If the operation being timed out is system() or qx(), this technique
+is liable to generate zombies. If this matters to you, you'll
+need to do your own fork() and exec(), and kill the errant child process.
+
For more complex signal handling, you might see the standard POSIX
module. Lamentably, this is almost entirely undocumented, but
the F<t/lib/posix.t> file from the Perl source distribution has some
=item *
-If the decimal point character in the C<LC_NUMERIC> locale is
-surreptitiously changed from a dot to a comma, C<sprintf("%g",
-0.123456e3)> produces a string result of "123,456". Many people would
-interpret this as one hundred and twenty-three thousand, four hundred
-and fifty-six.
+Some systems are broken in that they allow the "C" locale to be
+overridden by users. If the decimal point character in the
+C<LC_NUMERIC> category of the "C" locale is surreptitiously changed
+from a dot to a comma, C<sprintf("%g", 0.123456e3)> produces a
+string result of "123,456". Many people would interpret this as
+one hundred and twenty-three thousand, four hundred and fifty-six.
=item *
expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of
case-mapping with C<\l>, C<\L>,C<\u> or C<\U>.
-=item B<In-memory formatting function> (sprintf()):
-
-Result is tainted if C<use locale> is in effect.
-
=item B<Output formatting functions> (printf() and write()):
Success/failure result is never tainted.
=head2 Package Constructors and Destructors
-Three special subroutines act as package
-constructors and destructors. These are the C<BEGIN>, C<INIT>, and
-C<END> routines. The C<sub> is optional for these routines.
+Four special subroutines act as package constructors and destructors.
+These are the C<BEGIN>, C<STOP>, C<INIT>, and C<END> routines. The
+C<sub> is optional for these routines.
A C<BEGIN> subroutine is executed as soon as possible, that is, the moment
it is completely defined, even before the rest of the containing file
has run, it is immediately undefined and any code it used is returned to
Perl's memory pool. This means you can't ever explicitly call a C<BEGIN>.
-Similar to C<BEGIN> blocks, C<INIT> blocks are run just before the
-Perl runtime begins execution. For example, the code generators
-documented in L<perlcc> make use of C<INIT> blocks to initialize
-and resolve pointers to XSUBs.
-
-An C<END> subroutine is executed as late as possible, that is, when
-the interpreter is being exited, even if it is exiting as a result of
-a die() function. (But not if it's polymorphing into another program
-via C<exec>, or being blown out of the water by a signal--you have to
-trap that yourself (if you can).) You may have multiple C<END> blocks
-within a file--they will execute in reverse order of definition; that is:
-last in, first out (LIFO).
+An C<END> subroutine is executed as late as possible, that is, after
+perl has finished running the program and just before the interpreter
+is being exited, even if it is exiting as a result of a die() function.
+(But not if it's polymorphing into another program via C<exec>, or
+being blown out of the water by a signal--you have to trap that yourself
+(if you can).) You may have multiple C<END> blocks within a file--they
+will execute in reverse order of definition; that is: last in, first
+out (LIFO). C<END> blocks are not executed when you run perl with the
+C<-c> switch.
Inside an C<END> subroutine, C<$?> contains the value that the program is
going to pass to C<exit()>. You can modify C<$?> to change the exit
value of the program. Beware of changing C<$?> by accident (e.g. by
running something via C<system>).
+Similar to C<BEGIN> blocks, C<INIT> blocks are run just before the
+Perl runtime begins execution, in "first in, first out" (FIFO) order.
+For example, the code generators documented in L<perlcc> make use of
+C<INIT> blocks to initialize and resolve pointers to XSUBs.
+
+Similar to C<END> blocks, C<STOP> blocks are run just after the
+Perl compile phase ends and before the run time begins, in
+LIFO order. C<STOP> blocks are again useful in the Perl compiler
+suite to save the compiled state of the program.
+
When you use the B<-n> and B<-p> switches to Perl, C<BEGIN> and
C<END> work just as they do in B<awk>, as a degenerate case. As currently
implemented (and subject to change, since its inconvenient at best),
=item Africa
- South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
+ South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
+ ftp://ftp.saix.net/pub/CPAN/
+ ftp://ftp.sun.ac.za/CPAN/
ftp://ftpza.co.za/pub/mirrors/cpan/
=item Asia
- China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/
- Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
- Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/
- Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/
+ China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/
+ Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
+ ftp://ftp.pacific.net.hk/pub/mirror/CPAN/
+ Indonesia ftp://malone.piksi.itb.ac.id/pub/CPAN/
+ Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/
+ Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/
ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
ftp://ftp.meisei-u.ac.jp/pub/CPAN/
ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/
ftp://mirror.nucba.ac.jp/mirror/Perl/
- Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/
- South Korea ftp://ftp.bora.net/pub/CPAN/
+ Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/
+ South Korea ftp://ftp.bora.net/pub/CPAN/
+ ftp://ftp.kornet.net/pub/CPAN/
ftp://ftp.nuri.net/pub/CPAN/
- Taiwan ftp://ftp.wownet.net/pub2/PERL/
+ Taiwan ftp://coda.nctu.edu.tw/computer-languages/perl/CPAN/
+ ftp://ftp.ee.ncku.edu.tw/pub3/perl/CPAN/
+ ftp://ftp.wownet.net/pub2/PERL/
ftp://ftp1.sinica.edu.tw/pub1/perl/CPAN/
- Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/
+ Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/
ftp://ftp.nectec.or.th/pub/mirrors/CPAN/
=item Australasia
- Australia ftp://cpan.topend.com.au/pub/CPAN/
+ Australia ftp://cpan.topend.com.au/pub/CPAN/
ftp://ftp.labyrinth.net.au/pub/perl/CPAN/
ftp://ftp.sage-au.org.au/pub/compilers/perl/CPAN/
ftp://mirror.aarnet.edu.au/pub/perl/CPAN/
- New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/
+ New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/
ftp://sunsite.net.nz/pub/languages/perl/CPAN/
-Central America
+=item Central America
- Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/
+ Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/
=item Europe
- Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
- Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
- Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/
- Croatia ftp://ftp.linux.hr/pub/CPAN/
- Czech Republic ftp://ftp.fi.muni.cz/pub/perl/
+ Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
+ Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
+ Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/
+ Croatia ftp://ftp.linux.hr/pub/CPAN/
+ Czech Republic ftp://ftp.fi.muni.cz/pub/perl/
ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
- Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
- Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/
- Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
- France ftp://ftp.lip6.fr/pub/perl/CPAN/
+ Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
+ Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/
+ Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
+ France ftp://ftp.lip6.fr/pub/perl/CPAN/
ftp://ftp.oleane.net/pub/mirrors/CPAN/
ftp://ftp.pasteur.fr/pub/computing/CPAN/
- Germany ftp://ftp.archive.de.uu.net/pub/CPAN/
+ ftp://ftp.uvsq.fr/pub/perl/CPAN/
+ Germany ftp://ftp.archive.de.uu.net/pub/CPAN/
ftp://ftp.gmd.de/packages/CPAN/
ftp://ftp.gwdg.de/pub/languages/perl/CPAN/
ftp://ftp.leo.org/pub/comp/programming/languages/script/perl/CPAN/
ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
ftp://ftp.uni-erlangen.de/pub/source/CPAN/
ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
- Greece ftp://ftp.ntua.gr/pub/lang/perl/
- Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
- Ireland ftp://sunsite.compapp.dcu.ie/pub/perl/
- Italy ftp://cis.uniRoma2.it/CPAN/
+ Greece ftp://ftp.ntua.gr/pub/lang/perl/
+ Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
+ Iceland ftp://ftp.gm.is/pub/CPAN/
+ Ireland ftp://cpan.indigo.ie/pub/CPAN/
+ ftp://sunsite.compapp.dcu.ie/pub/perl/
+ Italy ftp://cis.uniRoma2.it/CPAN/
ftp://ftp.flashnet.it/pub/CPAN/
ftp://ftp.unina.it/pub/Other/CPAN/
ftp://ftp.unipi.it/pub/mirror/perl/CPAN/
- Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/
+ Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/
ftp://ftp.EU.net/packages/cpan/
ftp://ftp.nluug.nl/pub/languages/perl/CPAN/
- Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
+ Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
ftp://sunsite.uio.no/pub/languages/perl/CPAN/
- Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/
+ Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/
ftp://ftp.man.torun.pl/pub/doc/CPAN/
ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
ftp://sunsite.icm.edu.pl/pub/CPAN/
- Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/
+ Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/
ftp://ftp.ist.utl.pt/pub/CPAN/
ftp://ftp.ua.pt/pub/CPAN/
- Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/
+ Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/
ftp://ftp.dnttm.ro/pub/CPAN/
Russia ftp://ftp.chg.ru/pub/lang/perl/CPAN/
ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
- Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/
- Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
- Spain ftp://ftp.etse.urv.es/pub/perl/
+ Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/
+ Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
+ Spain ftp://ftp.etse.urv.es/pub/perl/
ftp://ftp.rediris.es/mirror/CPAN/
- Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
- Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/
- Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/
- United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
+ Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
+ Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/
+ Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/
+ United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
ftp://ftp.flirble.org/pub/languages/perl/CPAN/
+ ftp://ftp.mirror.ac.uk/sites/ftp.funet.fi/pub/languages/perl/CPAN/
ftp://ftp.plig.org/pub/CPAN/
ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
- ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
=item North America
- Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/
+ Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/
California ftp://cpan.nas.nasa.gov/pub/perl/CPAN/
+ ftp://cpan.valueclick.com/CPAN/
ftp://ftp.cdrom.com/pub/perl/CPAN/
ftp://ftp.digital.com/pub/plan/perl/CPAN/
- Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
- Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/
- Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
- Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/
+ California ftp://cpan.nas.nasa.gov/pub/perl/CPAN/
+ ftp://cpan.valueclick.com/CPAN/
+ ftp://ftp.cdrom.com/pub/perl/CPAN/
+ ftp://ftp.digital.com/pub/plan/perl/CPAN/
+ Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
+ Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/
+ Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
+ Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/
ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/
- Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
- Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/
+ Kentucky ftp://ftp.uky.edu/CPAN/
+ Manitoba ftp://theoryx5.uwinnipeg.ca/pub/CPAN/
+ Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/
ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
Mexico ftp://ftp.msg.com.mx/pub/CPAN/
Minnesota ftp://ftp.midearthbbs.com/CPAN/
- New York ftp://ftp.rge.com/pub/languages/perl/
- North Carolina ftp://ftp.duke.edu/pub/perl/
- Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
+ New York ftp://ftp.deao.net/pub/CPAN/
+ ftp://ftp.rge.com/pub/languages/perl/
+ ftp://ftp.tpj.com/pub/CPAN/
+ Nova Scotia ftp://cpan.chebucto.ns.ca/pub/CPAN/
+ North Carolina ftp://ftp.duke.edu/pub/perl/
+ Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
Ontario ftp://ftp.crc.ca/pub/packages/lang/perl/CPAN/
- Oregon ftp://ftp.orst.edu/pub/packages/CPAN/
- Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
- Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
- Utah ftp://mirror.xmission.com/CPAN/
- Virginia ftp://ftp.perl.org/pub/perl/CPAN/
+ Oregon ftp://ftp.orst.edu/pub/packages/CPAN/
+ Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
+ Tennessee ftp://ftp.sunsite.utk.edu/pub/CPAN/
+ Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
+ Utah ftp://mirror.xmission.com/CPAN/
+ Virginia ftp://ftp.perl.org/pub/perl/CPAN/
ftp://ruff.cs.jmu.edu/pub/CPAN/
Washington ftp://ftp-mirror.internap.com/pub/CPAN/
ftp://ftp.spu.edu/pub/CPAN/
=item South America
- Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/
+ Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/
+ ftp://ftp.matrix.com.br/pub/perl/
Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
=back
Tom Phoenix E<lt>rootbeer@teleport.comE<gt>,
Peter Prymmer E<lt>pvhp@forte.comE<gt>,
Hugo van der Sanden E<lt>hv@crypt0.demon.co.ukE<gt>,
-Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>,
+Gurusamy Sarathy E<lt>gsar@activestate.comE<gt>,
Paul J. Schinder E<lt>schinder@pobox.comE<gt>,
Michael G Schwern E<lt>schwern@pobox.comE<gt>,
Dan Sugalski E<lt>sugalskd@ous.eduE<gt>,
first character after the "[" is "^", the class matches any character not
in the list. Within a list, the "-" character specifies a
range, so that C<a-z> represents all characters between "a" and "z",
-inclusive. If you want "-" itself to be a member of a class, put it
-at the start or end of the list, or escape it with a backslash. (The
+inclusive. If you want either "-" or "]" itself to be a member of a
+class, put it at the start of the list (possibly after a "^"), or
+escape it with a backslash. "-" is also taken literally when it is
+at the end of the list, just before the closing "]". (The
following all specify the same class of three characters: C<[-az]>,
C<[az-]>, and C<[a\-z]>. All are different from C<[a-z]>, which
specifies a class containing twenty-six characters.)
=item B<-c>
causes Perl to check the syntax of the program and then exit without
-executing it. Actually, it I<will> execute C<BEGIN>, C<END>, and C<use> blocks,
-because these are considered as occurring outside the execution of
-your program. C<INIT> blocks, however, will be skipped.
+executing it. Actually, it I<will> execute C<BEGIN>, C<STOP>, and
+C<use> blocks, because these are considered as occurring outside the
+execution of your program. C<INIT> and C<END> blocks, however, will
+be skipped.
=item B<-d>
A colon-separated list of directories in which to look for Perl library
files before looking in the standard library and the current
-directory. If PERL5LIB is not defined, PERLLIB is used. When running
-taint checks (because the program was running setuid or setgid, or the
-B<-T> switch was used), neither variable is used. The program should
-instead say
+directory. Any architecture-specific directories under the specified
+locations are automatically included if they exist. If PERL5LIB is not
+defined, PERLLIB is used.
+
+When running taint checks (either because the program was running setuid
+or setgid, or the B<-T> switch was used), neither variable is used.
+The program should instead say:
use lib "/my/directory";
function in all capitals is a loosely-held convention meaning it
will be called indirectly by the run-time system itself, usually
due to a triggered event. Functions that do special, pre-defined
-things include C<BEGIN>, C<END>, C<AUTOLOAD>, and C<DESTROY>--plus
-all functions mentioned in L<perltie>. The 5.005 release adds
-C<INIT> to this list.
+things include C<BEGIN>, C<STOP>, C<INIT>, C<END>, C<AUTOLOAD>, and
+C<DESTROY>--plus all functions mentioned in L<perltie>.
=head2 Private Variables via my()
}
See L<perlmod/"Package Constructors and Destructors"> about the
-special triggered functions, C<BEGIN> and C<INIT>.
+special triggered functions, C<BEGIN>, C<STOP>, C<INIT> and C<END>.
If declared at the outermost scope (the file scope), then lexicals
work somewhat like C's file statics. They are available to all
refers to the innermost enclosing loop. This may include dynamically
looking back your call-stack at run time to find the LABEL. Such
desperate behavior triggers a warning if you use the B<-w> flag.
+Unlike a C<foreach> statement, a C<while> statement never implicitly
+localises any variables.
If there is a C<continue> BLOCK, it is always executed just before the
conditional is about to be evaluated again, just like the third part of a
=head2 END blocks
-END blocks need saving in compiled output.
+END blocks need saving in compiled output, now that STOP blocks
+are available.
=head2 _AUTOLOAD
# perl4 prints: second new
# perl5 prints: 3
-=item * Discontinuance
-
-In Perl 4 (and versions of Perl 5 before 5.004), C<'\r'> characters in
-Perl code were silently allowed, although they could cause (mysterious!)
-failures in certain constructs, particularly here documents. Now,
-C<'\r'> characters cause an immediate fatal error. (Note: In this
-example, the notation B<\015> represents the incorrect line
-ending. Depending upon your text viewer, it will look different.)
-
- print "foo";\015
- print "bar";
-
- # perl4 prints: foobar
- # perl5.003 prints: foobar
- # perl5.004 dies: Illegal character \015 (carriage return)
-
-See L<perldiag> for full details.
-
=item * Deprecation
Some error messages will be different.
Also see L<"General Regular Expression Traps using s///, etc.">
for another example of this new feature...
+=item * Bitwise string ops
+
+When bitwise operators which can operate upon either numbers or
+strings (C<& | ^ ~>) are given only strings as arguments, perl4 would
+treat the operands as bitstrings so long as the program contained a call
+to the C<vec()> function. perl5 treats the string operands as bitstrings.
+(See L<perlop/Bitwise String Operators> for more details.)
+
+ $fred = "10";
+ $barney = "12";
+ $betty = $fred & $barney;
+ print "$betty\n";
+ # Uncomment the next line to change perl4's behavior
+ # ($dummy) = vec("dummy", 0, 0);
+
+ # Perl4 prints:
+ 8
+
+ # Perl5 prints:
+ 10
+
+ # If vec() is used anywhere in the program, both print:
+ 10
+
=back
=head2 General data type traps
=head2 Introduction
-XS is a language used to create an extension interface
-between Perl and some C library which one wishes to use with
-Perl. The XS interface is combined with the library to
-create a new library which can be linked to Perl. An B<XSUB>
-is a function in the XS language and is the core component
-of the Perl application interface.
-
-The XS compiler is called B<xsubpp>. This compiler will embed
-the constructs necessary to let an XSUB, which is really a C
-function in disguise, manipulate Perl values and creates the
-glue necessary to let Perl access the XSUB. The compiler
+XS is an interface description file format used to create an extension
+interface between Perl and C code (or a C library) which one wishes
+to use with Perl. The XS interface is combined with the library to
+create a new library which can then be either dynamically loaded
+or statically linked into perl. The XS interface description is
+written in the XS language and is the core component of the Perl
+extension interface.
+
+An B<XSUB> forms the basic unit of the XS interface. After compilation
+by the B<xsubpp> compiler, each XSUB amounts to a C function definition
+which will provide the glue between Perl calling conventions and C
+calling conventions.
+
+The glue code pulls the arguments from the Perl stack, converts these
+Perl values to the formats expected by a C function, call this C function,
+transfers the return values of the C function back to Perl.
+Return values here may be a conventional C return value or any C
+function arguments that may serve as output parameters. These return
+values may be passed back to Perl either by putting them on the
+Perl stack, or by modifying the arguments supplied from the Perl side.
+
+The above is a somewhat simplified view of what really happens. Since
+Perl allows more flexible calling conventions than C, XSUBs may do much
+more in practice, such as checking input parameters for validity,
+throwing exceptions (or returning undef/empty list) if the return value
+from the C function indicates failure, calling different C functions
+based on numbers and types of the arguments, providing an object-oriented
+interface, etc.
+
+Of course, one could write such glue code directly in C. However, this
+would be a tedious task, especially if one needs to write glue for
+multiple C functions, and/or one is not familiar enough with the Perl
+stack discipline and other such arcana. XS comes to the rescue here:
+instead of writing this glue C code in long-hand, one can write
+a more concise short-hand I<description> of what should be done by
+the glue, and let the XS compiler B<xsubpp> handle the rest.
+
+The XS language allows one to describe the mapping between how the C
+routine is used, and how the corresponding Perl routine is used. It
+also allows creation of Perl routines which are directly translated to
+C code and which are not related to a pre-existing C function. In cases
+when the C interface coincides with the Perl interface, the XSUB
+declaration is almost identical to a declaration of a C function (in K&R
+style). In such circumstances, there is another tool called C<h2xs>
+that is able to translate an entire C header file into a corresponding
+XS file that will provide glue to the functions/macros described in
+the header file.
+
+The XS compiler is called B<xsubpp>. This compiler creates
+the constructs necessary to let an XSUB manipulate Perl values, and
+creates the glue necessary to let Perl call the XSUB. The compiler
uses B<typemaps> to determine how to map C function parameters
-and variables to Perl values. The default typemap handles
-many common C types. A supplement typemap must be created
-to handle special structures and types for the library being
-linked.
+and output values to Perl values and back. The default typemap
+(which comes with Perl) handles many common C types. A supplementary
+typemap may also be needed to handle any special structures and types
+for the library being linked.
+
+A file in XS format starts with a C language section which goes until the
+first C<MODULE =Z<>> directive. Other XS directives and XSUB definitions
+may follow this line. The "language" used in this part of the file
+is usually referred to as the XS language.
See L<perlxstut> for a tutorial on the whole extension creation process.
-Note: For many extensions, Dave Beazley's SWIG system provides a
-significantly more convenient mechanism for creating the XS glue
+Note: For some extensions, Dave Beazley's SWIG system may provide a
+significantly more convenient mechanism for creating the extension glue
code. See L<http://www.cs.utah.edu/~beazley/SWIG> for more
information.
rpcb_gettime(host,timep)
char *host
time_t &timep
- OUTPUT:
+ OUTPUT:
timep
Any extension to Perl, including those containing XSUBs,
=head2 The Anatomy of an XSUB
+The simplest XSUBs consist of 3 parts: a description of the return
+value, the name of the XSUB routine and the names of its arguments,
+and a description of types or formats of the arguments.
+
The following XSUB allows a Perl program to access a C library function
called sin(). The XSUB will imitate the C function which takes a single
argument and returns a single value.
sin(x)
double x
-When using C pointers the indirection operator C<*> should be considered
-part of the type and the address operator C<&> should be considered part of
-the variable, as is demonstrated in the rpcb_gettime() function above. See
-the section on typemaps for more about handling qualifiers and unary
+When using parameters with C pointer types, as in
+
+ double string_to_double(char *s);
+
+there may be two ways to describe this argument to B<xsubpp>:
+
+ char * s
+ char &s
+
+Both these XS declarations correspond to the C<char*> C type, but they have
+different semantics. It is convenient to think that the indirection operator
+C<*> should be considered as a part of the type and the address operator C<&>
+should be considered part of the variable. See L<"The Typemap"> and
+L<"The & Unary Operator"> for more info about handling qualifiers and unary
operators in C types.
The function name and the return type must be placed on
-separate lines.
+separate lines and should be flush left-adjusted.
INCORRECT CORRECT
The function body may be indented or left-adjusted. The following example
shows a function with its body left-adjusted. Most examples in this
-document will indent the body.
+document will indent the body for better readability.
CORRECT
sin(x)
double x
+More complicated XSUBs may contain many other sections. Each section of
+an XSUB starts with the corresponding keyword, such as INIT: or CLEANUP:.
+However, the first two lines of an XSUB always contain the same data:
+descriptions of the return type and the names of the function and its
+parameters. Whatever immediately follows these is considered to be
+an INPUT: section unless explicitly marked with another keyword.
+(See L<The INPUT: Keyword>.)
+
+An XSUB section continues until another section-start keyword is found.
+
=head2 The Argument Stack
-The argument stack is used to store the values which are
+The Perl argument stack is used to store the values which are
sent as parameters to the XSUB and to store the XSUB's
-return value. In reality all Perl functions keep their
-values on this stack at the same time, each limited to its
-own range of positions on the stack. In this document the
+return value(s). In reality all Perl functions (including non-XSUB
+ones) keep their values on this stack all the same time, each limited
+to its own range of positions on the stack. In this document the
first position on that stack which belongs to the active
function will be referred to as position 0 for that function.
=head2 The RETVAL Variable
-The RETVAL variable is a magic variable which always matches
-the return type of the C library function. The B<xsubpp> compiler will
-supply this variable in each XSUB and by default will use it to hold the
-return value of the C library function being called. In simple cases the
-value of RETVAL will be placed in ST(0) of the argument stack where it can
-be received by Perl as the return value of the XSUB.
+The RETVAL variable is a special C variable that is declared automatically
+for you. The C type of RETVAL matches the return type of the C library
+function. The B<xsubpp> compiler will declare this variable in each XSUB
+with non-C<void> return type. By default the generated C function
+will use RETVAL to hold the return value of the C library function being
+called. In simple cases the value of RETVAL will be placed in ST(0) of
+the argument stack where it can be received by Perl as the return value
+of the XSUB.
If the XSUB has a return type of C<void> then the compiler will
-not supply a RETVAL variable for that function. When using
-the PPCODE: directive the RETVAL variable is not needed, unless used
-explicitly.
+not declare a RETVAL variable for that function. When using
+a PPCODE: section no manipulation of the RETVAL variable is required, the
+section may use direct stack manipulation to place output values on the stack.
If PPCODE: directive is not used, C<void> return value should be used
only for subroutines which do not return a value, I<even if> CODE:
The OUTPUT: keyword indicates that certain function parameters should be
updated (new values made visible to Perl) when the XSUB terminates or that
certain values should be returned to the calling Perl function. For
-simple functions, such as the sin() function above, the RETVAL variable is
-automatically designated as an output value. In more complex functions
+simple functions which have no CODE: or PPCODE: section,
+such as the sin() function above, the RETVAL variable is
+automatically designated as an output value. For more complex functions
the B<xsubpp> compiler will need help to determine which variables are output
variables.
rpcb_gettime(host,timep)
char *host
time_t &timep
- OUTPUT:
+ OUTPUT:
timep
The OUTPUT: keyword will also allow an output parameter to
rpcb_gettime(host,timep)
char *host
time_t &timep
- OUTPUT:
+ OUTPUT:
timep sv_setnv(ST(1), (double)timep);
B<xsubpp> emits an automatic C<SvSETMAGIC()> for all parameters in the
This keyword is used in more complicated XSUBs which require
special handling for the C function. The RETVAL variable is
-available but will not be returned unless it is specified
-under the OUTPUT: keyword.
+still declared, but it will not be returned unless it is specified
+in the OUTPUT: section.
The following XSUB is for a C function which requires special handling of
its parameters. The Perl usage is given first.
rpcb_gettime(host,timep)
char *host
time_t timep
- CODE:
+ CODE:
RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ OUTPUT:
timep
RETVAL
rpcb_gettime(host,timep)
char *host
time_t &timep
- INIT:
+ INIT:
printf("# Host is %s\n", host );
- OUTPUT:
+ OUTPUT:
timep
+Another use for the INIT: section is to check for preconditions before
+making a call to the C function:
+
+ long long
+ lldiv(a,b)
+ long long a
+ long long b
+ INIT:
+ if (a == 0 && b == 0)
+ XSRETURN_UNDEF;
+ if (b == 0)
+ croak("lldiv: cannot divide by 0");
+
=head2 The NO_INIT Keyword
The NO_INIT keyword is used to indicate that a function
rpcb_gettime(host,timep)
char *host
time_t &timep = NO_INIT
- OUTPUT:
+ OUTPUT:
timep
=head2 Initializing Function Parameters
-Function parameters are normally initialized with their
-values from the argument stack. The typemaps contain the
-code segments which are used to transfer the Perl values to
+C function parameters are normally initialized with their values from
+the argument stack (which in turn contains the parameters that were
+passed to the XSUB from Perl). The typemaps contain the
+code segments which are used to translate the Perl values to
the C parameters. The programmer, however, is allowed to
override the typemaps and supply alternate (or additional)
-initialization code.
+initialization code. Initialization code starts with the first
+C<=>, C<;> or C<+> on a line in the INPUT: section. The only
+exception happens if this C<;> terminates the line, then this C<;>
+is quietly ignored.
The following code demonstrates how to supply initialization code for
function parameters. The initialization code is eval'd within double
rpcb_gettime(host,timep)
char *host = (char *)SvPV($arg,PL_na);
time_t &timep = 0;
- OUTPUT:
+ OUTPUT:
timep
This should not be used to supply default values for parameters. One
another library function before it can be used. Default parameters are
covered in the next section.
-If the initialization begins with C<=>, then it is output on
-the same line where the input variable is declared. If the
-initialization begins with C<;> or C<+>, then it is output after
-all of the input variables have been declared. The C<=> and C<;>
-cases replace the initialization normally supplied from the typemap.
-For the C<+> case, the initialization from the typemap will precede
-the initialization code included after the C<+>. A global
+If the initialization begins with C<=>, then it is output in
+the declaration for the input variable, replacing the initialization
+supplied by the typemap. If the initialization
+begins with C<;> or C<+>, then it is performed after
+all of the input variables have been declared. In the C<;>
+case the initialization normally supplied by the typemap is not performed.
+For the C<+> case, the declaration for the variable will include the
+initialization from the typemap. A global
variable, C<%v>, is available for the truly rare case where
information from one initialization is needed in another
initialization.
+Here's a truly obscure example:
+
bool_t
rpcb_gettime(host,timep)
- time_t &timep ; /*\$v{time}=@{[$v{time}=$arg]}*/
- char *host + SvOK($v{time}) ? SvPV($arg,PL_na) : NULL;
- OUTPUT:
+ time_t &timep ; /* \$v{timep}=@{[$v{timep}=$arg]} */
+ char *host + SvOK($v{timep}) ? SvPV($arg,PL_na) : NULL;
+ OUTPUT:
timep
+The construct C<\$v{timep}=@{[$v{timep}=$arg]}> used in the above
+example has a two-fold purpose: first, when this line is processed by
+B<xsubpp>, the Perl snippet C<$v{timep}=$arg> is evaluated. Second,
+the text of the evaluated snippet is output into the generated C file
+(inside a C comment)! During the processing of C<char *host> line,
+$arg will evaluate to C<ST(0)>, and C<$v{timep}> will evaluate to
+C<ST(1)>.
+
=head2 Default Parameter Values
-Default values can be specified for function parameters by
+Default values for XSUB arguments can be specified by
placing an assignment statement in the parameter list. The
default value may be a number or a string. Defaults should
always be used on the right-most parameters only.
To allow the XSUB for rpcb_gettime() to have a default host
value the parameters to the XSUB could be rearranged. The
XSUB will then call the real rpcb_gettime() function with
-the parameters in the correct order. Perl will call this
-XSUB with either of the following statements.
+the parameters in the correct order. This XSUB can be called
+from Perl with either of the following statements:
$status = rpcb_gettime( $timep, $host );
rpcb_gettime(timep,host="localhost")
char *host
time_t timep = NO_INIT
- CODE:
+ CODE:
RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ OUTPUT:
timep
RETVAL
=head2 The PREINIT: Keyword
-The PREINIT: keyword allows extra variables to be declared before the
-typemaps are expanded. If a variable is declared in a CODE: block then that
-variable will follow any typemap code. This may result in a C syntax
-error. To force the variable to be declared before the typemap code, place
-it into a PREINIT: block. The PREINIT: keyword may be used one or more
-times within an XSUB.
+The PREINIT: keyword allows extra variables to be declared immediately
+before or after the declartions of the parameters from the INPUT: section
+are emitted.
+
+If a variable is declared inside a CODE: section it will follow any typemap
+code that is emitted for the input parameters. This may result in the
+declaration ending up after C code, which is C syntax error. Similar
+errors may happen with an explicit C<;>-type or C<+>-type initialization of
+parameters is used (see L<"Initializing Function Parameters">). Declaring
+these variables in an INIT: section will not help.
+
+In such cases, to force an additional variable to be declared together
+with declarations of other variables, place the declaration into a
+PREINIT: section. The PREINIT: keyword may be used one or more times
+within an XSUB.
The following examples are equivalent, but if the code is using complex
typemaps then the first example is safer.
bool_t
rpcb_gettime(timep)
time_t timep = NO_INIT
- PREINIT:
+ PREINIT:
char *host = "localhost";
- CODE:
+ CODE:
RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ OUTPUT:
timep
RETVAL
-A correct, but error-prone example.
+For this particular case an INIT: keyword would generate the
+same C code as the PREINIT: keyword. Another correct, but error-prone example:
bool_t
rpcb_gettime(timep)
time_t timep = NO_INIT
- CODE:
+ CODE:
char *host = "localhost";
RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ OUTPUT:
+ timep
+ RETVAL
+
+Another way to declare C<host> is to use a C block in the CODE: section:
+
+ bool_t
+ rpcb_gettime(timep)
+ time_t timep = NO_INIT
+ CODE:
+ {
+ char *host = "localhost";
+ RETVAL = rpcb_gettime( host, &timep );
+ }
+ OUTPUT:
+ timep
+ RETVAL
+
+The ability to put additional declarations before the typemap entries are
+processed is very handy in the cases when typemap conversions manipulate
+some global state:
+
+ MyObject
+ mutate(o)
+ PREINIT:
+ MyState st = global_state;
+ INPUT:
+ MyObject o;
+ CLEANUP:
+ reset_to(global_state, st);
+
+Here we suppose that conversion to C<MyObject> in the INPUT: section and from
+MyObject when processing RETVAL will modify a global variable C<global_state>.
+After these conversions are performed, we restore the old value of
+C<global_state> (to avoid memory leaks, for example).
+
+There is another way to trade clarity for compactness: INPUT sections allow
+declaration of C variables which do not appear in the parameter list of
+a subroutine. Thus the above code for mutate() can be rewritten as
+
+ MyObject
+ mutate(o)
+ MyState st = global_state;
+ MyObject o;
+ CLEANUP:
+ reset_to(global_state, st);
+
+and the code for rpcb_gettime() can be rewritten as
+
+ bool_t
+ rpcb_gettime(timep)
+ time_t timep = NO_INIT
+ char *host = "localhost";
+ C_ARGS:
+ host, &timep
+ OUTPUT:
timep
RETVAL
enabled, the XSUB will invoke ENTER and LEAVE automatically.
To support potentially complex type mappings, if a typemap entry used
-by this XSUB contains a comment like C</*scope*/> then scoping will
-automatically be enabled for that XSUB.
+by an XSUB contains a comment like C</*scope*/> then scoping will
+be automatically enabled for that XSUB.
To enable scoping:
bool_t
rpcb_gettime(host,timep)
char *host
- PREINIT:
+ PREINIT:
time_t tt;
- INPUT:
+ INPUT:
time_t timep
- CODE:
+ CODE:
RETVAL = rpcb_gettime( host, &tt );
timep = tt;
- OUTPUT:
+ OUTPUT:
timep
RETVAL
bool_t
rpcb_gettime(host,timep)
- PREINIT:
+ PREINIT:
time_t tt;
- INPUT:
+ INPUT:
char *host
- PREINIT:
+ PREINIT:
char *h;
- INPUT:
+ INPUT:
time_t timep
- CODE:
+ CODE:
h = host;
RETVAL = rpcb_gettime( h, &tt );
timep = tt;
- OUTPUT:
+ OUTPUT:
+ timep
+ RETVAL
+
+Since INPUT sections allow declaration of C variables which do not appear
+in the parameter list of a subroutine, this may be shortened to:
+
+ bool_t
+ rpcb_gettime(host,timep)
+ time_t tt;
+ char *host;
+ char *h = host;
+ time_t timep;
+ CODE:
+ RETVAL = rpcb_gettime( h, &tt );
+ timep = tt;
+ OUTPUT:
timep
RETVAL
+(We used our knowledge that input conversion for C<char *> is a "simple" one,
+thus C<host> is initialized on the declaration line, and our assignment
+C<h = host> is not performed too early. Otherwise one would need to have the
+assignment C<h = host> in a CODE: or INIT: section.)
+
=head2 Variable-length Parameter Lists
XSUBs can have variable-length parameter lists by specifying an ellipsis
bool_t
rpcb_gettime(timep, ...)
time_t timep = NO_INIT
- PREINIT:
+ PREINIT:
char *host = "localhost";
STRLEN n_a;
- CODE:
- if( items > 1 )
- host = (char *)SvPV(ST(1), n_a);
- RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ CODE:
+ if( items > 1 )
+ host = (char *)SvPV(ST(1), n_a);
+ RETVAL = rpcb_gettime( host, &timep );
+ OUTPUT:
timep
RETVAL
The C_ARGS: keyword allows creating of XSUBS which have different
calling sequence from Perl than from C, without a need to write
-CODE: or CPPCODE: section. The contents of the C_ARGS: paragraph is
+CODE: or PPCODE: section. The contents of the C_ARGS: paragraph is
put as the argument to the called C function without any change.
-For example, suppose that C function is declared as
+For example, suppose that a C function is declared as
symbolic nth_derivative(int n, symbolic function, int flags);
nth_derivative(function, n)
symbolic function
int n
- C_ARGS:
+ C_ARGS:
n, function, default_flags
=head2 The PPCODE: Keyword
control the argument stack for the XSUBs return values. Occasionally one
will want an XSUB to return a list of values rather than a single value.
In these cases one must use PPCODE: and then explicitly push the list of
-values on the stack. The PPCODE: and CODE: keywords are not used
+values on the stack. The PPCODE: and CODE: keywords should not be used
together within the same XSUB.
+The actual difference between PPCODE: and CODE: sections is in the
+initialization of C<SP> macro (which stands for the I<current> Perl
+stack pointer), and in the handling of data on the stack when returning
+from an XSUB. In CODE: sections SP preserves the value which was on
+entry to the XSUB: SP is on the function pointer (which follows the
+last parameter). In PPCODE: sections SP is moved backward to the
+beginning of the parameter list, which allows C<PUSH*()> macros
+to place output values in the place Perl expects them to be when
+the XSUB returns back to Perl.
+
+The generated trailer for a CODE: section ensures that the number of return
+values Perl will see is either 0 or 1 (depending on the C<void>ness of the
+return value of the C function, and heuristics mentioned in
+L<"The RETVAL Variable">). The trailer generated for a PPCODE: section
+is based on the number of return values and on the number of times
+C<SP> was updated by C<[X]PUSH*()> macros.
+
+Note that macros C<ST(i)>, C<XST_m*()> and C<XSRETURN*()> work equally
+well in CODE: sections and PPCODE: sections.
+
The following XSUB will call the C rpcb_gettime() function
and will return its two output values, timep and status, to
Perl as a single list.
void
rpcb_gettime(host)
char *host
- PREINIT:
+ PREINIT:
time_t timep;
bool_t status;
- PPCODE:
+ PPCODE:
status = rpcb_gettime( host, &timep );
EXTEND(SP, 2);
PUSHs(sv_2mortal(newSViv(status)));
SV *
rpcb_gettime(host)
char * host
- PREINIT:
+ PREINIT:
time_t timep;
bool_t x;
- CODE:
+ CODE:
ST(0) = sv_newmortal();
if( rpcb_gettime( host, &timep ) )
sv_setnv( ST(0), (double)timep);
SV *
rpcb_gettime(host)
char * host
- PREINIT:
+ PREINIT:
time_t timep;
bool_t x;
- CODE:
+ CODE:
ST(0) = sv_newmortal();
if( rpcb_gettime( host, &timep ) ){
sv_setnv( ST(0), (double)timep);
void
rpcb_gettime(host)
char *host
- PREINIT:
+ PREINIT:
time_t timep;
- PPCODE:
+ PPCODE:
if( rpcb_gettime( host, &timep ) )
PUSHs(sv_2mortal(newSViv(timep)));
else{
- /* Nothing pushed on stack, so an empty */
- /* list is implicitly returned. */
+ /* Nothing pushed on stack, so an empty
+ * list is implicitly returned. */
}
Some people may be inclined to include an explicit C<return> in the above
the XSUB stack is properly adjusted. Consult L<perlguts/"API LISTING"> for
other C<XSRETURN> macros.
+Since C<XSRETURN_*> macros can be used with CODE blocks as well, one can
+rewrite this example as:
+
+ int
+ rpcb_gettime(host)
+ char *host
+ PREINIT:
+ time_t timep;
+ CODE:
+ RETVAL = rpcb_gettime( host, &timep );
+ if (RETVAL == 0)
+ XSRETURN_UNDEF;
+ OUTPUT:
+ RETVAL
+
+In fact, one can put this check into a CLEANUP: section as well. Together
+with PREINIT: simplifications, this leads to:
+
+ int
+ rpcb_gettime(host)
+ char *host
+ time_t timep;
+ CLEANUP:
+ if (RETVAL == 0)
+ XSRETURN_UNDEF;
+
=head2 The REQUIRE: Keyword
The REQUIRE: keyword is used to indicate the minimum version of the
bool_t
rpcb_gettime(timep, ...)
time_t timep = NO_INIT
- PROTOTYPE: $;$
- PREINIT:
+ PROTOTYPE: $;$
+ PREINIT:
char *host = "localhost";
STRLEN n_a;
- CODE:
+ CODE:
if( items > 1 )
host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
- OUTPUT:
+ OUTPUT:
timep
RETVAL
rpcb_gettime(host,timep)
char *host
time_t &timep
- ALIAS:
+ ALIAS:
FOO::gettime = 1
BAR::getit = 2
- INIT:
+ INIT:
printf("# ix = %d\n", ix );
- OUTPUT:
+ OUTPUT:
timep
=head2 The INTERFACE: Keyword
This keyword declares the current XSUB as a keeper of the given
calling signature. If some text follows this keyword, it is
considered as a list of functions which have this signature, and
-should be attached to XSUBs.
+should be attached to the current XSUB.
-Say, if you have 4 functions multiply(), divide(), add(), subtract() all
-having the signature
+For example, if you have 4 C functions multiply(), divide(), add(),
+subtract() all having the signature:
symbolic f(symbolic, symbolic);
-you code them all by using XSUB
+you can make them all to use the same XSUB using this:
symbolic
interface_s_ss(arg1, arg2)
multiply divide
add subtract
-The advantage of this approach comparing to ALIAS: keyword is that one
+(This is the complete XSUB code for 4 Perl functions!) Four generated
+Perl function share names with corresponding C functions.
+
+The advantage of this approach comparing to ALIAS: keyword is that there
+is no need to code a switch statement, each Perl function (which shares
+the same XSUB) knows which C function it should call. Additionally, one
can attach an extra function remainder() at runtime by using
-
+
CV *mycv = newXSproto("Symbolic::remainder",
XS_Symbolic_interface_s_ss, __FILE__, "$$");
XSINTERFACE_FUNC_SET(mycv, remainder);
-(This example supposes that there was no INTERFACE_MACRO: section,
-otherwise one needs to use something else instead of
-C<XSINTERFACE_FUNC_SET>.)
+say, from another XSUB. (This example supposes that there was no
+INTERFACE_MACRO: section, otherwise one needs to use something else instead of
+C<XSINTERFACE_FUNC_SET>, see the next section.)
=head2 The INTERFACE_MACRO: Keyword
interface_s_ss(arg1, arg2)
symbolic arg1
symbolic arg2
- INTERFACE_MACRO:
+ INTERFACE_MACRO:
XSINTERFACE_FUNC_BYOFFSET
XSINTERFACE_FUNC_BYOFFSET_set
- INTERFACE:
+ INTERFACE:
multiply divide
add subtract
rpcb_gettime(host,timep)
char *host
time_t &timep
- OUTPUT:
+ OUTPUT:
timep
The XS module can use INCLUDE: to pull that file into it.
long
rpcb_gettime(a,b)
CASE: ix == 1
- ALIAS:
+ ALIAS:
x_gettime = 1
- INPUT:
+ INPUT:
# 'a' is timep, 'b' is host
char *b
time_t a = NO_INIT
- CODE:
+ CODE:
RETVAL = rpcb_gettime( b, &a );
- OUTPUT:
+ OUTPUT:
a
RETVAL
CASE:
# 'a' is host, 'b' is timep
char *a
time_t &b = NO_INIT
- OUTPUT:
+ OUTPUT:
b
RETVAL
=head2 The & Unary Operator
-The & unary operator is used to tell the compiler that it should dereference
-the object when it calls the C function. This is used when a CODE: block is
-not used and the object is a not a pointer type (the object is an C<int> or
-C<long> but not a C<int*> or C<long*>).
+The C<&> unary operator in the INPUT: section is used to tell B<xsubpp>
+that it should convert a Perl value to/from C using the C type to the left
+of C<&>, but provide a pointer to this value when the C function is called.
+
+This is useful to avoid a CODE: block for a C function which takes a parameter
+by reference. Typically, the parameter should be not a pointer type (an
+C<int> or C<long> but not a C<int*> or C<long*>).
-The following XSUB will generate incorrect C code. The xsubpp compiler will
+The following XSUB will generate incorrect C code. The B<xsubpp> compiler will
turn this into code which calls C<rpcb_gettime()> with parameters C<(char
*host, time_t timep)>, but the real C<rpcb_gettime()> wants the C<timep>
parameter to be of type C<time_t*> rather than C<time_t>.
rpcb_gettime(host,timep)
char *host
time_t timep
- OUTPUT:
+ OUTPUT:
timep
-That problem is corrected by using the C<&> operator. The xsubpp compiler
+That problem is corrected by using the C<&> operator. The B<xsubpp> compiler
will now turn this into code which calls C<rpcb_gettime()> correctly with
parameters C<(char *host, time_t *timep)>. It does this by carrying the
C<&> through, so the function call looks like C<rpcb_gettime(host, &timep)>.
rpcb_gettime(host,timep)
char *host
time_t &timep
- OUTPUT:
+ OUTPUT:
timep
=head2 Inserting Comments and C Preprocessor Directives
#if ... version2
#endif
-because otherwise xsubpp will believe that you made a duplicate
+because otherwise B<xsubpp> will believe that you made a duplicate
definition of the function. Also, put a blank line before the
#else/#endif so it will not be seen as part of the function body.
=head2 Using XS With C++
-If a function is defined as a C++ method then it will assume
+If an XSUB name contains C<::>, it is considered to be a C++ method.
+The generated Perl function will assume that
its first argument is an object pointer. The object pointer
will be stored in a variable called THIS. The object should
have been created by C++ with the new() function and should
blessing of the object by Perl can be handled by a typemap. An example
typemap is shown at the end of this section.
-If the method is defined as static it will call the C++
+If the return type of the XSUB includes C<static>, the method is considered
+to be a static method. It will call the C++
function using the class::method() syntax. If the method is not static
the function will be called using the THIS-E<gt>method() syntax.
color::set_blue( val )
int val
-Both functions will expect an object as the first parameter. The xsubpp
-compiler will call that object C<THIS> and will use it to call the specified
-method. So in the C++ code the blue() and set_blue() methods will be called
-in the following manner.
+Both Perl functions will expect an object as the first parameter. In the
+generated C++ code the object is called C<THIS>, and the method call will
+be performed on this object. So in the C++ code the blue() and set_blue()
+methods will be called as this:
RETVAL = THIS->blue();
THIS->set_blue( val );
If the function's name is B<DESTROY> then the C++ C<delete> function will be
-called and C<THIS> will be given as its parameter.
+called and C<THIS> will be given as its parameter. The generated C++ code for
void
color::DESTROY()
-The C++ code will call C<delete>.
+will look like this:
+
+ color *THIS = ...; // Initialized as in typemap
delete THIS;
color *
color::new()
-The C++ code will call C<new>.
+The generated C++ code will call C<new>.
- RETVAL = new color();
+ RETVAL = new color();
The following is an example of a typemap that could be used for this C++
example.
=head2 Interface Strategy
When designing an interface between Perl and a C library a straight
-translation from C to XS is often sufficient. The interface will often be
+translation from C to XS (such as created by C<h2xs -x>) is often sufficient.
+However, sometimes the interface will look
very C-like and occasionally nonintuitive, especially when the C function
-modifies one of its parameters. In cases where the programmer wishes to
+modifies one of its parameters, or returns failure inband (as in "negative
+return values mean failure"). In cases where the programmer wishes to
create a more Perl-like interface the following strategy may help to
identify the more critical parts of the interface.
-Identify the C functions which modify their parameters. The XSUBs for
-these functions may be able to return lists to Perl, or may be
-candidates to return undef or an empty list in case of failure.
+Identify the C functions with input/output or output parameters. The XSUBs for
+these functions may be able to return lists to Perl.
+
+Identify the C functions which use some inband info as an indication
+of failure. They may be
+candidates to return undef or an empty list in case of failure. If the
+failure may be detected without a call to the C function, you may want to use
+an INIT: section to report the failure. For failures detectable after the C
+function returns one may want to use a CLEANUP: section to process the
+failure. In more complicated cases use CODE: or PPCODE: sections.
+
+If many functions use the same failure indication based on the return value,
+you may want to create a special typedef to handle this situation. Put
+
+ typedef int negative_is_failure;
+
+near the beginning of XS file, and create an OUTPUT typemap entry
+for C<negative_is_failure> which converts negative values to C<undef>, or
+maybe croak()s. After this the return value of type C<negative_is_failure>
+will create more Perl-like interface.
Identify which values are used by only the C and XSUB functions
-themselves. If Perl does not need to access the contents of the value
+themselves, say, when a parameter to a function should be a contents of a
+global variable. If Perl does not need to access the contents of the value
then it may not be necessary to provide a translation for that value
from C to Perl.
Identify the pointers in the C function parameter lists and return
-values. Some pointers can be handled in XS with the & unary operator on
-the variable name while others will require the use of the * operator on
-the type name. In general it is easier to work with the & operator.
+values. Some pointers may be used to implement input/output or
+output parameters, they can be handled in XS with the C<&> unary operator,
+and, possibly, using the NO_INIT keyword.
+Some others will require handling of types like C<int *>, and one needs
+to decide what a useful Perl translation will do in such a case. When
+the semantic is clear, it is advisable to put the translation into a typemap
+file.
Identify the structures used by the C functions. In many
cases it may be helpful to use the T_PTROBJ typemap for
these structures so they can be manipulated by Perl as
-blessed objects.
+blessed objects. (This is handled automatically by C<h2xs -x>.)
+
+If the same C type is used in several different contexts which require
+different translations, C<typedef> several new types mapped to this C type,
+and create separate F<typemap> entries for these new types. Use these
+types in declarations of return type and parameters to XSUBs.
=head2 Perl Objects And C Structures
void
rpcb_DESTROY(netconf)
Netconfig *netconf
- CODE:
+ CODE:
printf("Now in NetconfigPtr::DESTROY\n");
free( netconf );
The typemap is a collection of code fragments which are used by the B<xsubpp>
compiler to map C function parameters and values to Perl values. The
typemap file may consist of three sections labeled C<TYPEMAP>, C<INPUT>, and
-C<OUTPUT>. Any unlabelled initial section is assumed to be a C<TYPEMAP>
-section if a name is not explicitly specified. The INPUT section tells
+C<OUTPUT>. An unlabelled initial section is assumed to be a C<TYPEMAP>
+section. The INPUT section tells
the compiler how to translate Perl values
into variables of certain C types. The OUTPUT section tells the compiler
how to translate the values from certain C types into values Perl can
here. Note that the C type is separated from the XS type with a tab and
that the C unary operator C<*> is considered to be a part of the C type name.
- TYPEMAP
- Netconfig *<tab>T_PTROBJ
+ TYPEMAP
+ Netconfig *<tab>T_PTROBJ
Here's a more complicated example: suppose that you wanted C<struct
netconfig> to be blessed into the class C<Net::Config>. One way to do
SV *
rpcb_gettime(host="localhost")
char *host
- PREINIT:
+ PREINIT:
time_t timep;
- CODE:
+ CODE:
ST(0) = sv_newmortal();
if( rpcb_gettime( host, &timep ) )
sv_setnv( ST(0), (double)timep );
void
rpcb_DESTROY(netconf)
Netconfig *netconf
- CODE:
+ CODE:
printf("NetconfigPtr::DESTROY\n");
free( netconf );
=head1 AUTHOR
-Dean Roehrich <F<roehrich@cray.com>>
-Jul 8, 1996
+Originally written by Dean Roehrich <F<roehrich@cray.com>>.
+
+Maintained since 1996 by The Perl Porters <F<perlbug@perl.com>>.
=head2 Version caveat
-This tutorial tries hard to keep up with the latest development versions
-of Perl. This often means that it is sometimes in advance of the latest
-released version of Perl, and that certain features described here might
-not work on earlier versions. See the section on "Troubleshooting
-these Examples" for more information.
+When writing a Perl extension for general consumption, one should expect that
+the extension will be used with versions of Perl different from the
+version available on your machine. Since you are reading this document,
+the version of Perl on your machine is probably 5.005 or later, but the users
+of your extension may have more ancient versions.
+
+To understand what kinds of incompatibilities one may expect, and in the rare
+case that the version of Perl on your machine is older than this document,
+see the section on "Troubleshooting these Examples" for more information.
+
+If your extension uses some features of Perl which are not available on older
+releases of Perl, your users would appreciate an early meaningful warning.
+You would probably put this information into the F<README> file, but nowadays
+installation of extensions may be performed automatically, guided by F<CPAN.pm>
+module or other tools.
+
+In MakeMaker-based installations, F<Makefile.PL> provides the earliest
+opportunity to perform version checks. One can put something like this
+in F<Makefile.PL> for this purpose:
+
+ eval { require 5.007 }
+ or die <<EOD;
+ ############
+ ### This module uses frobnication framework which is not available before
+ ### version 5.007 of Perl. Upgrade your Perl before installing Kara::Mba.
+ ############
+ EOD
=head2 Dynamic Loading versus Static Loading
=head2 The XSUBPP Program
-The xsubpp program takes the XS code in the .xs file and translates it into
+The B<xsubpp> program takes the XS code in the .xs file and translates it into
C code, placing it in a file whose suffix is .c. The C code created makes
heavy use of the C functions within Perl.
=head2 The TYPEMAP file
-The xsubpp program uses rules to convert from Perl's data types (scalar,
+The B<xsubpp> program uses rules to convert from Perl's data types (scalar,
array, etc.) to C's data types (int, char, etc.). These rules are stored
in the typemap file ($PERLLIB/ExtUtils/typemap). This file is split into
three parts.
The first section maps various C data types to a name, which corresponds
somewhat with the various Perl types. The second section contains C code
-which xsubpp uses to handle input parameters. The third section contains
-C code which xsubpp uses to handle output parameters.
+which B<xsubpp> uses to handle input parameters. The third section contains
+C code which B<xsubpp> uses to handle output parameters.
Let's take a look at a portion of the .c file created for our extension.
The file name is Mytest.c:
=back
-=head2 More about XSUBPP
+=head2 Anatomy of .xs file
+
+The .xs file of L<"EXAMPLE 4"> contained some new elements. To understand
+the meaning of these elements, pay attention to the line which reads
+
+ MODULE = Mytest2 PACKAGE = Mytest2
+
+Anything before this line is plain C code which describes which headers
+to include, and defines some convenience functions. No translations are
+performed on this part, it goes into the generated output C file as is.
+
+Anything after this line is the description of XSUB functions.
+These descriptions are translated by B<xsubpp> into C code which
+implements these functions using Perl calling conventions, and which
+makes these functions visible from Perl interpreter.
+
+Pay a special attention to the function C<constant>. This name appears
+twice in the generated .xs file: once in the first part, as a static C
+function, the another time in the second part, when an XSUB interface to
+this static C function is defined.
+
+This is quite typical for .xs files: usually the .xs file provides
+an interface to an existing C function. Then this C function is defined
+somewhere (either in an external library, or in the first part of .xs file),
+and a Perl interface to this function (i.e. "Perl glue") is described in the
+second part of .xs file. The situation in L<"EXAMPLE 1">, L<"EXAMPLE 2">,
+and L<"EXAMPLE 3">, when all the work is done inside the "Perl glue", is
+somewhat of an exception rather than the rule.
+
+=head2 Getting the fat out of XSUBs
+
+In L<"EXAMPLE 4"> the second part of .xs file contained the following
+description of an XSUB:
+
+ double
+ foo(a,b,c)
+ int a
+ long b
+ const char * c
+ OUTPUT:
+ RETVAL
+
+Note that in contrast with L<"EXAMPLE 1">, L<"EXAMPLE 2"> and L<"EXAMPLE 3">,
+this description does not contain the actual I<code> for what is done
+is done during a call to Perl function foo(). To understand what is going
+on here, one can add a CODE section to this XSUB:
+
+ double
+ foo(a,b,c)
+ int a
+ long b
+ const char * c
+ CODE:
+ RETVAL = foo(a,b,c);
+ OUTPUT:
+ RETVAL
+
+However, these two XSUBs provide almost identical generated C code: B<xsubpp>
+compiler is smart enough to figure out the C<CODE:> section from the first
+two lines of the description of XSUB. What about C<OUTPUT:> section? In
+fact, that is absolutely the same! The C<OUTPUT:> section can be removed
+as well, I<as far as C<CODE:> section or C<PPCODE:> section> is not
+specified: B<xsubpp> can see that it needs to generate a function call
+section, and will autogenerate the OUTPUT section too. Thus one can
+shortcut the XSUB to become:
+
+ double
+ foo(a,b,c)
+ int a
+ long b
+ const char * c
+
+Can we do the same with an XSUB
+
+ int
+ is_even(input)
+ int input
+ CODE:
+ RETVAL = (input % 2 == 0);
+ OUTPUT:
+ RETVAL
+
+of L<"EXAMPLE 2">? To do this, one needs to define a C function C<int
+is_even(int input)>. As we saw in L<Anatomy of .xs file>, a proper place
+for this definition is in the first part of .xs file. In fact a C function
+
+ int
+ is_even(int arg)
+ {
+ return (arg % 2 == 0);
+ }
+
+is probably overkill for this. Something as simple as a C<#define> will
+do too:
+
+ #define is_even(arg) ((arg) % 2 == 0)
+
+After having this in the first part of .xs file, the "Perl glue" part becomes
+as simple as
+
+ int
+ is_even(input)
+ int input
+
+This technique of separation of the glue part from the workhorse part has
+obvious tradeoffs: if you want to change a Perl interface, you need to
+change two places in your code. However, it removes a lot of clutter,
+and makes the workhorse part independent from idiosyncrasies of Perl calling
+convention. (In fact, there is nothing Perl-specific in the above description,
+a different version of B<xsubpp> might have translated this to TCL glue or
+Python glue as well.)
+
+=head2 More about XSUB arguments
With the completion of Example 4, we now have an easy way to simulate some
real-life libraries whose interfaces may not be the cleanest in the world.
We shall now continue with a discussion of the arguments passed to the
-xsubpp compiler.
+B<xsubpp> compiler.
When you specify arguments to routines in the .xs file, you are really
passing three pieces of information for each argument listed. The first
piece is the order of that argument relative to the others (first, second,
etc). The second is the type of argument, and consists of the type
declaration of the argument (e.g., int, char*, etc). The third piece is
-the exact way in which the argument should be used in the call to the
-library function from this XSUB. This would mean whether or not to place
-a "&" before the argument or not, meaning the argument expects to be
-passed the address of the specified data type.
+the calling convention for the argument in the call to the library function.
+
+While Perl passes arguments to functions by reference,
+C passes arguments by value; to implement a C function which modifies data
+of one of the "arguments", the actual argument of this C function would be
+a pointer to the data. Thus two C functions with declarations
+
+ int string_length(char *s);
+ int upper_case_char(char *cp);
+
+may have completely different semantics: the first one may inspect an array
+of chars pointed by s, and the second one may immediately dereference C<cp>
+and manipulate C<*cp> only (using the return value as, say, a success
+indicator). From Perl one would use these functions in
+a completely different manner.
+
+One conveys this info to B<xsubpp> by replacing C<*> before the
+argument by C<&>. C<&> means that the argument should be passed to a library
+function by its address. The above two function may be XSUB-ified as
+
+ int
+ string_length(s)
+ char * s
+
+ int
+ upper_case_char(cp)
+ char &cp
-There is a difference between the two arguments in this hypothetical function:
+For example, consider:
int
foo(a,b)
char &a
char * b
-The first argument to this function would be treated as a char and assigned
+The first Perl argument to this function would be treated as a char and assigned
to the variable a, and its address would be passed into the function foo.
-The second argument would be treated as a string pointer and assigned to the
+The second Perl argument would be treated as a string pointer and assigned to the
variable b. The I<value> of b would be passed into the function foo. The
-actual call to the function foo that xsubpp generates would look like this:
+actual call to the function foo that B<xsubpp> generates would look like this:
foo(&a, b);
-Xsubpp will parse the following function argument lists identically:
+B<xsubpp> will parse the following function argument lists identically:
char &a
char&a
therefore the first argument passed to the XSUB, ST(1) is the second
argument, and so on.
-When you list the arguments to the XSUB in the .xs file, that tells xsubpp
+When you list the arguments to the XSUB in the .xs file, that tells B<xsubpp>
which argument corresponds to which of the argument stack (i.e., the first
one listed is the first argument, and so on). You invite disaster if you
do not list them in the same order as the function expects them.
The arg variable is initially set by taking the value from ST(0), then is
stored back into ST(0) at the end of the routine.
+XSUBs are also allowed to return lists, not just scalars. This must be
+done by manipulating stack values ST(0), ST(1), etc, in a subtly
+different way. See L<perlxs> for details.
+
+XSUBs are also allowed to avoid automatic conversion of Perl function arguments
+to C function arguments. See L<perlxs> for details. Some people prefer
+manual conversion by inspecting C<ST(i)> even in the cases when automatic
+conversion will do, arguing that this makes the logic of an XSUB call clearer.
+Compare with L<"Getting the fat out of XSUBs"> for a similar tradeoff of
+a complete separation of "Perl glue" and "workhorse" parts of an XSUB.
+
+While experts may argue about these idioms, a novice to Perl guts may
+prefer a way which is as little Perl-guts-specific as possible, meaning
+automatic conversion and automatic call generation, as in
+L<"Getting the fat out of XSUBs">. This approach has the additional
+benefit of protecting the XSUB writer from future changes to the Perl API.
+
=head2 Extending your Extension
Sometimes you might want to provide some extra methods or subroutines
void
statfs(path)
char * path
- PREINIT:
+ INIT:
int i;
struct statfs buf;
=item *
-The PREINIT: directive contains code that will be placed immediately after
-variable declaration and before the argument stack is decoded. Some compilers
-cannot handle variable declarations at arbitrary locations inside a function,
+The INIT: directive contains code that will be placed immediately after
+the argument stack is decoded. C does not allow variable declarations at
+arbitrary locations inside a function,
so this is usually the best way to declare local variables needed by the XSUB.
+(Alternatively, one could put the whole C<PPCODE:> section into braces, and
+put these declarations on top.)
=item *
returned.
We do this by using the PPCODE: directive, rather than the CODE: directive.
-This tells xsubpp that we will be managing the return values that will be
+This tells B<xsubpp> that we will be managing the return values that will be
put on the argument stack by ourselves.
=item *
we use the series of macros that begin with "XPUSH". There are five
different versions, for placing integers, unsigned integers, doubles,
strings, and Perl scalars on the stack. In our example, we placed a
-Perl scalar onto the stack.
+Perl scalar onto the stack. (In fact this is the only macro which
+can be used to return multiple values.)
The XPUSH* macros will automatically extend the return stack to prevent
it from being overrun. You push values onto the stack in the order you
If they were not mortal, then they would continue to exist after the XSUB
routine returned, but would not be accessible. This is a memory leak.
+=item *
+
+If we were interested in performance, not in code compactness, in the success
+branch we would not use C<XPUSHs> macros, but C<PUSHs> macros, and would
+pre-extend the stack before pushing the return values:
+
+ EXTEND(SP, 9);
+
+The tradeoff is that one needs to calculate the number of return values
+in advance (though overextending the stack will not typically hurt
+anything but memory consumption).
+
+Similarly, in the failure branch we could use C<PUSHs> I<without> extending
+the stack: the Perl function reference comes to an XSUB on the stack, thus
+the stack is I<always> large enough to take one return value.
+
=back
=head2 EXAMPLE 6 (Coming Soon)
=head2 Last Changed
-1999/5/25
+1999/11/30
#############################################################################
use strict;
-use diagnostics;
+#use diagnostics;
=head1 NAME
=head1 SYNOPSIS
-B<podchecker> [B<-help>] [B<-man>] [I<file>S< >...]
+B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]
=head1 OPTIONS AND ARGUMENTS
Print the manual page and exit.
+=item B<-warnings> B<-nowarnings>
+
+Turn on/off printing of warnings.
+
=item I<file>
The pathname of a POD file to syntax-check (defaults to standard input).
B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
Please see L<Pod::Checker/podchecker()> for more details.
+=head1 RETURN VALUE
+
+B<podchecker> returns a 0 (zero) exit status if all specified
+POD files are ok.
+
+=head1 ERRORS
+
+B<podchecker> returns the exit status 1 if at least one of
+the given POD files has syntax errors.
+
+The status 2 indicates that at least one of the specified
+files does not contain I<any> POD commands.
+
+Status 1 overrides status 2. If you want unambigouus
+results, call B<podchecker> with one single argument only.
+
=head1 SEE ALSO
L<Pod::Parser> and L<Pod::Checker>
-=head1 AUTHOR
+=head1 AUTHORS
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
+Brad Appleton E<lt>bradapp@enteract.comE<gt>,
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
Based on code for B<Pod::Text::pod2text(1)> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
my %options = (
"help" => 0,
"man" => 0,
+ "warnings" => 1,
);
## Parse options
-GetOptions(\%options, "help", "man") || pod2usage(2);
+GetOptions(\%options, "help", "man", "warnings!") || pod2usage(2);
pod2usage(1) if ($options{help});
pod2usage(-verbose => 2) if ($options{man});
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
## Invoke podchecker()
-if(@ARGV) {
- for (@ARGV) { podchecker($_) };
-} else {
- podchecker("<&STDIN");
+my $status = 0;
+@ARGV = ("<&STDIN") unless(@ARGV);
+for (@ARGV) {
+ my $s = podchecker($_, undef, '-warnings' => $options{warnings});
+ if($s > 0) {
+ # errors occurred
+ $status = 1;
+ }
+ elsif($s < 0) {
+ # no pod found
+ $status = 2 unless($status);
+ }
}
+exit $status;
!NO!SUBS!
$mandir/perlmod.1 \
$mandir/perlmodlib.1 \
$mandir/perlmodinstall.1 \
+ $mandir/perlfork.1 \
$mandir/perlform.1 \
$mandir/perllocale.1 \
$mandir/perlref.1 \
* NI-S 1999/05/07
*/
if (PL_op->op_private & OPpDEREF) {
- GV *gv = (GV *) newSV(0);
- STRLEN len = 0;
- char *name = "";
- if (cUNOP->op_first->op_type == OP_PADSV) {
- SV **namep = av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4);
- if (namep && *namep) {
- name = SvPV(*namep,len);
- if (!name) {
- name = "";
- len = 0;
- }
- }
+ char *name;
+ GV *gv;
+ if (cUNOP->op_targ) {
+ STRLEN len;
+ SV *namesv = PL_curpad[cUNOP->op_targ];
+ name = SvPV(namesv, len);
+ gv = (GV*)NEWSV(0,0);
+ gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
+ }
+ else {
+ name = CopSTASHPV(PL_curcop);
+ gv = newGVgen(name);
}
- gv_init(gv, PL_curcop->cop_stash, name, len, 0);
sv_upgrade(sv, SVt_RV);
- SvRV(sv) = (SV *) gv;
+ SvRV(sv) = (SV*)gv;
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
- }
+ }
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "a symbol");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "a SCALAR");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
HV *stash;
if (MAXARG == 1)
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
else {
SV *ssv = POPs;
STRLEN len;
Newz(602, gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = NEWSV(72,0);
- GvLINE(sv) = PL_curcop->cop_line;
+ GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
}
u = (U32)SEED_C1 * when;
# endif
#endif
- u += SEED_C3 * (U32)getpid();
+ u += SEED_C3 * (U32)PerlProc_getpid();
u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
u += SEED_C5 * (U32)PTR2UV(&when);
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
}
}
else {
- if (!SvPADTMP(sv)) {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
sv_setsv(TARG, sv);
sv = TARG;
*MARK++ = *SP;
*SP-- = tmp;
}
+ /* safe as long as stack cannot get extended in the above */
SP = oldsp;
}
else {
{
djSP;
dPOPPOPssrl;
- SV **oldsp = SP;
+ I32 start_sp_offset = SP - PL_stack_base;
I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
I32 datumtype;
register I32 len;
register I32 bits;
+ register char *str;
/* These must not be in registers: */
I16 ashort;
s += len;
break;
case '/':
- if (oldsp >= SP)
+ if (start_sp_offset >= SP - PL_stack_base)
DIE(aTHX_ "/ must follow a numeric type");
datumtype = *pat++;
if (*pat == '*')
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'b') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 1;
else
bits = *s++;
- *pat++ = '0' + (bits & 1);
+ *str++ = '0' + (bits & 1);
}
}
else {
bits <<= 1;
else
bits = *s++;
- *pat++ = '0' + ((bits & 128) != 0);
+ *str++ = '0' + ((bits & 128) != 0);
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'H':
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'h') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[bits & 15];
+ *str++ = PL_hexdigit[bits & 15];
}
}
else {
bits <<= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[(bits >> 4) & 15];
+ *str++ = PL_hexdigit[(bits >> 4) & 15];
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'c':
checksum = 0;
}
}
- if (SP == oldsp && gimme == G_SCALAR)
+ if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR)
PUSHs(&PL_sv_undef);
RETURN;
}
case 'B':
case 'b':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+7)/8;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'B') {
for (len = 0; len++ < aint;) {
- items |= *pat++ & 1;
+ items |= *str++ & 1;
if (len & 7)
items <<= 1;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (*pat++ & 1)
+ if (*str++ & 1)
items |= 128;
if (len & 7)
items >>= 1;
items >>= 7 - (aint & 7);
*aptr++ = items & 0xff;
}
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
case 'H':
case 'h':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+1)/2;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'H') {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= ((*pat++ & 15) + 9) & 15;
+ if (isALPHA(*str))
+ items |= ((*str++ & 15) + 9) & 15;
else
- items |= *pat++ & 15;
+ items |= *str++ & 15;
if (len & 1)
items <<= 4;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= (((*pat++ & 15) + 9) & 15) << 4;
+ if (isALPHA(*str))
+ items |= (((*str++ & 15) + 9) & 15) << 4;
else
- items |= (*pat++ & 15) << 4;
+ items |= (*str++ & 15) << 4;
if (len & 1)
items >>= 4;
else {
}
if (aint & 1)
*aptr++ = items & 0xff;
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
}
break;
-#endif /* HAS_QUAD */
+#endif
case 'P':
len = 1; /* assume SV is correct length */
/* FALL THROUGH */
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ || (SvPADTMP(fromstr)
+ && !SvREADONLY(fromstr))))
+ {
Perl_warner(aTHX_ WARN_UNSAFE,
"Attempt to pack pointer to temporary value");
+ }
if (SvPOK(fromstr) || SvNIOK(fromstr))
aptr = SvPV(fromstr,n_a);
else
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
- if (pm->op_pmreplroot)
+ if (pm->op_pmreplroot) {
+#ifdef USE_ITHREADS
+ ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
+#else
ary = GvAVn((GV*)pm->op_pmreplroot);
+#endif
+ }
else if (gimme != G_ARRAY)
#ifdef USE_THREADS
ary = (AV*)PL_curpad[0];
Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: unlock 0x%lx\n",
- (unsigned long)thr, (unsigned long)svv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(svv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
}
#endif /* USE_THREADS */
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: pp_lock lock 0x%lx\n",
- (unsigned long)thr, (unsigned long)sv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
static I32 sortcv(pTHXo_ SV *a, SV *b);
+static I32 sortcv_stacked(pTHXo_ SV *a, SV *b);
+static I32 sortcv_xsub(pTHXo_ SV *a, SV *b);
static I32 sv_ncmp(pTHXo_ SV *a, SV *b);
static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b);
static I32 amagic_ncmp(pTHXo_ SV *a, SV *b);
/* SAVE_DEFSV does *not* suffice here for USE_THREADS */
SAVESPTR(DEFSV);
ENTER; /* enter inner scope */
- SAVESPTR(PL_curpm);
+ SAVEVPTR(PL_curpm);
src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
SV *src;
ENTER; /* enter inner scope */
- SAVESPTR(PL_curpm);
+ SAVEVPTR(PL_curpm);
src = PL_stack_base[PL_markstack_ptr[-1]];
SvTEMP_off(src);
I32 gimme = GIMME;
OP* nextop = PL_op->op_next;
I32 overloading = 0;
+ bool hasargs = FALSE;
+ I32 is_xsub = 0;
if (gimme != G_ARRAY) {
SP = MARK;
}
ENTER;
- SAVEPPTR(PL_sortcop);
+ SAVEVPTR(PL_sortcop);
if (PL_op->op_flags & OPf_STACKED) {
if (PL_op->op_flags & OPf_SPECIAL) {
OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */
kid = kUNOP->op_first; /* pass rv2gv */
kid = kUNOP->op_first; /* pass leave */
PL_sortcop = kid->op_next;
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
else {
cv = sv_2cv(*++MARK, &stash, &gv, 0);
+ if (cv && SvPOK(cv)) {
+ STRLEN n_a;
+ char *proto = SvPV((SV*)cv, n_a);
+ if (proto && strEQ(proto, "$$")) {
+ hasargs = TRUE;
+ }
+ }
if (!(cv && CvROOT(cv))) {
- if (gv) {
+ if (cv && CvXSUB(cv)) {
+ is_xsub = 1;
+ }
+ else if (gv) {
SV *tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, Nullch);
- if (cv && CvXSUB(cv))
- DIE(aTHX_ "Xsub \"%s\" called in sort", SvPVX(tmpstr));
DIE(aTHX_ "Undefined sort subroutine \"%s\" called",
SvPVX(tmpstr));
}
- if (cv) {
- if (CvXSUB(cv))
- DIE(aTHX_ "Xsub called in sort");
+ else {
DIE(aTHX_ "Undefined subroutine in sort");
}
- DIE(aTHX_ "Not a CODE reference in sort");
}
- PL_sortcop = CvSTART(cv);
- SAVESPTR(CvROOT(cv)->op_ppaddr);
- CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
- SAVESPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+ if (is_xsub)
+ PL_sortcop = (OP*)cv;
+ else {
+ PL_sortcop = CvSTART(cv);
+ SAVEVPTR(CvROOT(cv)->op_ppaddr);
+ CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
+
+ SAVEVPTR(PL_curpad);
+ PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+ }
}
}
else {
PL_sortcop = Nullop;
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
up = myorigmark + 1;
PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
if (!(PL_op->op_flags & OPf_SPECIAL)) {
- bool hasargs = FALSE;
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
PUSHSUB(cx);
(void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
PL_sortcxix = cxstack_ix;
- qsortsv((myorigmark+1), max, sortcv);
+
+ if (hasargs && !is_xsub) {
+ /* This is mostly copied from pp_entersub */
+ AV *av = (AV*)PL_curpad[0];
+
+#ifndef USE_THREADS
+ cx->blk_sub.savearray = GvAV(PL_defgv);
+ GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+ cx->blk_sub.argarray = av;
+ }
+ qsortsv((myorigmark+1), max,
+ is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
POPBLOCK(cx,PL_curpm);
PL_stack_sp = newsp;
Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
+ case CXt_FORMAT:
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ PL_op_name[PL_op->op_type]);
+ break;
case CXt_EVAL:
if (ckWARN(WARN_UNSAFE))
Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
continue;
case CXt_EVAL:
case CXt_SUB:
+ case CXt_FORMAT:
DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
return i;
}
Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
+ case CXt_FORMAT:
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ PL_op_name[PL_op->op_type]);
+ break;
case CXt_EVAL:
if (ckWARN(WARN_UNSAFE))
Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
break;
case CXt_NULL:
break;
+ case CXt_FORMAT:
+ POPFORMAT(cx);
+ break;
}
cxstack_ix--;
}
PERL_SI *top_si = PL_curstackinfo;
I32 dbcxix;
I32 gimme;
- HV *hv;
+ char *stashname;
SV *sv;
I32 count = 0;
}
cx = &ccstack[cxix];
- if (CxTYPE(cx) == CXt_SUB) {
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
dbcxix = dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
cx = &ccstack[dbcxix];
}
+ stashname = CopSTASHPV(cx->blk_oldcop);
if (GIMME != G_ARRAY) {
- hv = cx->blk_oldcop->cop_stash;
- if (!hv)
+ if (!stashname)
PUSHs(&PL_sv_undef);
else {
dTARGET;
- sv_setpv(TARG, HvNAME(hv));
+ sv_setpv(TARG, stashname);
PUSHs(TARG);
}
RETURN;
}
- hv = cx->blk_oldcop->cop_stash;
- if (!hv)
+ if (!stashname)
PUSHs(&PL_sv_undef);
else
- PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
- PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)),
- SvCUR(GvSV(cx->blk_oldcop->cop_filegv)))));
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
+ PUSHs(sv_2mortal(newSVpv(stashname, 0)));
+ PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0)));
+ PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
if (!MAXARG)
RETURN;
- if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+ /* So is ccstack[dbcxix]. */
sv = NEWSV(49, 0);
gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
PUSHs(sv_2mortal(sv));
PUSHs(&PL_sv_undef);
}
if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
- && PL_curcop->cop_stash == PL_debstash)
+ && CopSTASH_eq(PL_curcop, PL_debstash))
{
AV *ary = cx->blk_sub.argarray;
int off = AvARRAY(ary) - AvALLOC(ary);
tmps = "";
else
tmps = POPpx;
- sv_reset(tmps, PL_curcop->cop_stash);
+ sv_reset(tmps, CopSTASH(PL_curcop));
PUSHs(&PL_sv_yes);
RETURN;
}
PUSHSUB(cx);
CvDEPTH(cv)++;
(void)SvREFCNT_inc(cv);
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
RETURNOP(CvSTART(cv));
}
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
+ U32 cxtype = CXt_LOOP;
+#ifdef USE_ITHREADS
+ void *iterdata;
+#endif
ENTER;
SAVETMPS;
if (PL_op->op_targ) {
svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */
SAVESPTR(*svp);
+#ifdef USE_ITHREADS
+ iterdata = (void*)PL_op->op_targ;
+ cxtype |= CXp_PADVAR;
+#endif
}
else {
- svp = &GvSV((GV*)POPs); /* symbol table variable */
+ GV *gv = (GV*)POPs;
+ svp = &GvSV(gv); /* symbol table variable */
SAVEGENERICSV(*svp);
*svp = NEWSV(0,0);
+#ifdef USE_ITHREADS
+ iterdata = (void*)gv;
+#endif
}
ENTER;
- PUSHBLOCK(cx, CXt_LOOP, SP);
+ PUSHBLOCK(cx, cxtype, SP);
+#ifdef USE_ITHREADS
+ PUSHLOOP(cx, iterdata, MARK);
+#else
PUSHLOOP(cx, svp, MARK);
+#endif
if (PL_op->op_flags & OPf_STACKED) {
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
SV *sv;
if (PL_curstackinfo->si_type == PERLSI_SORT) {
- if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) {
+ if (cxstack_ix == PL_sortcxix
+ || dopoptosub(cxstack_ix) <= PL_sortcxix)
+ {
if (cxstack_ix > PL_sortcxix)
dounwind(PL_sortcxix);
AvARRAY(PL_curstack)[1] = *SP;
DIE(aTHX_ "%s did not return a true value", name);
}
break;
+ case CXt_FORMAT:
+ POPFORMAT(cx);
+ break;
default:
DIE(aTHX_ "panic: return");
}
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
- DIE(aTHX_ "Can't \"last\" outside a block");
+ DIE(aTHX_ "Can't \"last\" outside a loop block");
}
else {
cxix = dopoptolabel(cPVOP->op_pv);
POPEVAL(cx);
nextop = pop_return();
break;
+ case CXt_FORMAT:
+ POPFORMAT(cx);
+ nextop = pop_return();
+ break;
default:
DIE(aTHX_ "panic: last");
}
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
- DIE(aTHX_ "Can't \"next\" outside a block");
+ DIE(aTHX_ "Can't \"next\" outside a loop block");
}
else {
cxix = dopoptolabel(cPVOP->op_pv);
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
- DIE(aTHX_ "Can't \"redo\" outside a block");
+ DIE(aTHX_ "Can't \"redo\" outside a loop block");
}
else {
cxix = dopoptolabel(cPVOP->op_pv);
SP[1] = SP[0];
SP--;
}
- fp3 = (I32(*)(int,int,int)))CvXSUB(cv;
+ fp3 = (I32(*)(int,int,int))CvXSUB(cv);
items = (*fp3)(CvXSUBANY(cv).any_i32,
mark - PL_stack_base + 1,
items);
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILLp((AV*)svp[1]);
+ I32 names_fill = AvFILLp((AV*)svp[0]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
- if (svp[ix] != &PL_sv_undef) {
+ if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
char *name = SvPVX(svp[ix]);
if ((SvFLAGS(svp[ix]) & SVf_FAKE)
|| *name == '&')
SvPADMY_on(sv);
}
}
+ else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+ av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+ }
else {
av_store(newpad, ix, sv = NEWSV(0,0));
SvPADTMP_on(sv);
}
}
#endif /* USE_THREADS */
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
#ifndef USE_THREADS
if (cx->blk_sub.hasargs)
break;
}
/* FALL THROUGH */
+ case CXt_FORMAT:
case CXt_NULL:
- DIE(aTHX_ "Can't \"goto\" outside a block");
+ DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
default:
if (ix)
DIE(aTHX_ "panic: goto");
anum = 0;
#endif
}
+ PL_exit_flags |= PERL_EXIT_EXPECTED;
my_exit(anum);
PUSHs(&PL_sv_undef);
RETURN;
/* switch to eval mode */
if (PL_curcop == &PL_compiling) {
- SAVESPTR(PL_compiling.cop_stash);
- PL_compiling.cop_stash = PL_curstash;
+ SAVECOPSTASH(&PL_compiling);
+ CopSTASH_set(&PL_compiling, PL_curstash);
}
- SAVESPTR(PL_compiling.cop_filegv);
- SAVEI16(PL_compiling.cop_line);
+ SAVECOPFILE(&PL_compiling);
+ SAVECOPLINE(&PL_compiling);
sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
- PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
- PL_compiling.cop_line = 1;
+ CopFILE_set(&PL_compiling, tmpbuf+2);
+ CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
(i.e. before run-time proper). To work around the coredump that
#ifdef OP_IN_REGISTER
PL_opsave = op;
#else
- SAVEPPTR(PL_op);
+ SAVEVPTR(PL_op);
#endif
PL_hints = 0;
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, 0, Nullgv);
rop = doeval(G_SCALAR, startop);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
{
dSP;
OP *saveop = PL_op;
- HV *newstash;
CV *caller;
AV* comppadlist;
I32 i;
/* set up a scratch pad */
SAVEI32(PL_padix);
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
SAVESPTR(PL_comppad);
SAVESPTR(PL_comppad_name);
SAVEI32(PL_comppad_name_fill);
PERL_CONTEXT *cx = &cxstack[i];
if (CxTYPE(cx) == CXt_EVAL)
break;
- else if (CxTYPE(cx) == CXt_SUB) {
+ else if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
caller = cx->blk_sub.cv;
break;
}
/* make sure we compile in the right package */
- newstash = PL_curcop->cop_stash;
- if (PL_curstash != newstash) {
+ if (CopSTASH_ne(PL_curcop, PL_curstash)) {
SAVESPTR(PL_curstash);
- PL_curstash = newstash;
+ PL_curstash = CopSTASH(PL_curcop);
}
SAVESPTR(PL_beginav);
PL_beginav = newAV();
}
SvREFCNT_dec(PL_rs);
PL_rs = SvREFCNT_inc(PL_nrs);
- PL_compiling.cop_line = 0;
+ CopLINE_set(&PL_compiling, 0);
if (startop) {
*startop = PL_eval_root;
SvREFCNT_dec(CvOUTSIDE(PL_compcv));
if (cv) {
dSP;
PUSHMARK(SP);
- XPUSHs((SV*)PL_compiling.cop_filegv);
+ XPUSHs((SV*)CopFILEGV(&PL_compiling));
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
}
/* prepare to compile file */
- if (*name == '/' ||
- (*name == '.' &&
- (name[1] == '/' ||
- (name[1] == '.' && name[2] == '/')))
-#ifdef DOSISH
- || (name[0] && name[1] == ':')
-#endif
-#ifdef WIN32
- || (name[0] == '\\' && name[1] == '\\') /* UNC path */
-#endif
-#ifdef VMS
- || (strchr(name,':') || ((*name == '[' || *name == '<') &&
- (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
-#endif
- )
+ if (PERL_FILE_IS_ABSOLUTE(name)
+ || (*name == '.' && (name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))))
{
tryname = name;
tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
}
- Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s",
- SvANY(loader), name);
+ Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
+ PTR2UV(SvANY(loader)), name);
tryname = SvPVX(namesv);
tryrsfp = 0;
}
}
}
- SAVESPTR(PL_compiling.cop_filegv);
- PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+ SAVECOPFILE(&PL_compiling);
+ CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
SvREFCNT_dec(namesv);
if (!tryrsfp) {
if (PL_op->op_type == OP_REQUIRE) {
/* Assume success here to prevent recursive requirement. */
(void)hv_store(GvHVn(PL_incgv), name, strlen(name),
- newSVsv(GvSV(PL_compiling.cop_filegv)), 0 );
+ newSVpv(CopFILE(&PL_compiling), 0), 0 );
ENTER;
SAVETMPS;
PL_rsfp_filters = Nullav;
PL_rsfp = tryrsfp;
- name = savepv(name);
- SAVEFREEPV(name);
SAVEHINTS();
PL_hints = 0;
- SAVEPPTR(PL_compiling.cop_warnings);
+ SAVESPTR(PL_compiling.cop_warnings);
if (PL_dowarn & G_WARN_ALL_ON)
PL_compiling.cop_warnings = WARN_ALL ;
else if (PL_dowarn & G_WARN_ALL_OFF)
/* switch to eval mode */
push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, name, Nullgv);
- SAVEI16(PL_compiling.cop_line);
- PL_compiling.cop_line = 0;
+ SAVECOPLINE(&PL_compiling);
+ CopLINE_set(&PL_compiling, 0);
PUTBACK;
#ifdef USE_THREADS
/* switch to eval mode */
- SAVESPTR(PL_compiling.cop_filegv);
+ SAVECOPFILE(&PL_compiling);
sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
- PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
- PL_compiling.cop_line = 1;
+ CopFILE_set(&PL_compiling, tmpbuf+2);
+ CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
(i.e. before run-time proper). To work around the coredump that
SAVEDELETE(PL_defstash, safestr, strlen(safestr));
SAVEHINTS();
PL_hints = PL_op->op_targ;
- SAVEPPTR(PL_compiling.cop_warnings);
+ SAVESPTR(PL_compiling.cop_warnings);
if (!specialWARN(PL_compiling.cop_warnings)) {
PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
SAVEFREESV(PL_compiling.cop_warnings) ;
push_return(PL_op->op_next);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, 0, Nullgv);
/* prepare to compile string */
if (PERLDB_LINE && PL_curstash != PL_debstash)
- save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr);
+ save_lines(CopFILEAV(&PL_compiling), PL_linestr);
PUTBACK;
#ifdef USE_THREADS
MUTEX_LOCK(&PL_eval_mutex);
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#undef this
#define this pPerl
#include "XSUB.h"
return result;
}
+static I32
+sortcv_stacked(pTHXo_ SV *a, SV *b)
+{
+ dTHR;
+ I32 oldsaveix = PL_savestack_ix;
+ I32 oldscopeix = PL_scopestack_ix;
+ I32 result;
+ AV *av;
+
+#ifdef USE_THREADS
+ av = (AV*)PL_curpad[0];
+#else
+ av = GvAV(PL_defgv);
+#endif
+
+ if (AvMAX(av) < 1) {
+ SV** ary = AvALLOC(av);
+ if (AvARRAY(av) != ary) {
+ AvMAX(av) += AvARRAY(av) - AvALLOC(av);
+ SvPVX(av) = (char*)ary;
+ }
+ if (AvMAX(av) < 1) {
+ AvMAX(av) = 1;
+ Renew(ary,2,SV*);
+ SvPVX(av) = (char*)ary;
+ }
+ }
+ AvFILLp(av) = 1;
+
+ AvARRAY(av)[0] = a;
+ AvARRAY(av)[1] = b;
+ PL_stack_sp = PL_stack_base;
+ PL_op = PL_sortcop;
+ CALLRUNOPS(aTHX);
+ if (PL_stack_sp != PL_stack_base + 1)
+ Perl_croak(aTHX_ "Sort subroutine didn't return single value");
+ if (!SvNIOKp(*PL_stack_sp))
+ Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
+ result = SvIV(*PL_stack_sp);
+ while (PL_scopestack_ix > oldscopeix) {
+ LEAVE;
+ }
+ leave_scope(oldsaveix);
+ return result;
+}
+
+static I32
+sortcv_xsub(pTHXo_ SV *a, SV *b)
+{
+ dSP;
+ I32 oldsaveix = PL_savestack_ix;
+ I32 oldscopeix = PL_scopestack_ix;
+ I32 result;
+ CV *cv=(CV*)PL_sortcop;
+
+ SP = PL_stack_base;
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ *++SP = a;
+ *++SP = b;
+ PUTBACK;
+ (void)(*CvXSUB(cv))(aTHXo_ cv);
+ if (PL_stack_sp != PL_stack_base + 1)
+ Perl_croak(aTHX_ "Sort subroutine didn't return single value");
+ if (!SvNIOKp(*PL_stack_sp))
+ Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
+ result = SvIV(*PL_stack_sp);
+ while (PL_scopestack_ix > oldscopeix) {
+ LEAVE;
+ }
+ leave_scope(oldsaveix);
+ return result;
+}
+
static I32
sv_ncmp(pTHXo_ SV *a, SV *b)
PP(pp_const)
{
djSP;
- XPUSHs(cSVOP->op_sv);
+ XPUSHs(cSVOP_sv);
RETURN;
}
djSP;
EXTEND(SP,1);
if (PL_op->op_private & OPpLVAL_INTRO)
- PUSHs(save_scalar(cGVOP->op_gv));
+ PUSHs(save_scalar(cGVOP_gv));
else
- PUSHs(GvSV(cGVOP->op_gv));
+ PUSHs(GvSV(cGVOP_gv));
RETURN;
}
PP(pp_gv)
{
djSP;
- XPUSHs((SV*)cGVOP->op_gv);
+ XPUSHs((SV*)cGVOP_gv);
RETURN;
}
PP(pp_aelemfast)
{
djSP;
- AV *av = GvAV((GV*)cSVOP->op_sv);
+ AV *av = GvAV(cGVOP_gv);
U32 lval = PL_op->op_flags & OPf_MOD;
SV** svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "an ARRAY");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (GIMME == G_ARRAY) {
(void)POPs;
RETURN;
PL_op->op_private & HINT_STRICT_REFS)
DIE(aTHX_ PL_no_usym, "a HASH");
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (GIMME == G_ARRAY) {
SP--;
RETURN;
if (!fp) {
if (IoFLAGS(io) & IOf_ARGV) {
if (IoFLAGS(io) & IOf_START) {
- IoFLAGS(io) &= ~IOf_START;
IoLINES(io) = 0;
if (av_len(GvAVn(PL_last_in_gv)) < 0) {
+ IoFLAGS(io) &= ~IOf_START;
do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
SvSETMAGIC(GvSV(PL_last_in_gv));
fp = nextargv(PL_last_in_gv);
if (!fp) { /* Note: fp != IoIFP(io) */
(void)do_close(PL_last_in_gv, FALSE); /* now it does*/
- IoFLAGS(io) |= IOf_START;
}
}
else if (type == OP_GLOB) {
}
}
#else /* !VMS */
+#ifdef MACOS_TRADITIONAL
+ sv_setpv(tmpcmd, "glob ");
+ sv_catsv(tmpcmd, tmpglob);
+ sv_catpv(tmpcmd, " |");
+#else
#ifdef DOSISH
#ifdef OS2
sv_setpv(tmpcmd, "for a in ");
#endif
#endif /* !CSH */
#endif /* !DOSISH */
+#endif /* MACOS_TRADITIONAL */
(void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
FALSE, O_RDONLY, 0, Nullfp);
fp = IoIFP(io);
if (fp)
continue;
(void)do_close(PL_last_in_gv, FALSE);
- IoFLAGS(io) |= IOf_START;
}
else if (type == OP_GLOB) {
if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
register PERL_CONTEXT *cx;
SV* sv;
AV* av;
+ SV **itersvp;
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
if (CxTYPE(cx) != CXt_LOOP)
DIE(aTHX_ "panic: pp_iter");
+ itersvp = CxITERVAR(cx);
av = cx->blk_loop.iterary;
if (SvTYPE(av) != SVt_PVAV) {
/* iterate ($min .. $max) */
char *max = SvPV((SV*)av, maxlen);
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
#ifndef USE_THREADS /* don't risk potential race */
- if (SvREFCNT(*cx->blk_loop.itervar) == 1
- && !SvMAGICAL(*cx->blk_loop.itervar))
- {
+ if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
- sv_setsv(*cx->blk_loop.itervar, cur);
+ sv_setsv(*itersvp, cur);
}
else
#endif
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as
* they used to */
- SvREFCNT_dec(*cx->blk_loop.itervar);
- *cx->blk_loop.itervar = newSVsv(cur);
+ SvREFCNT_dec(*itersvp);
+ *itersvp = newSVsv(cur);
}
if (strEQ(SvPVX(cur), max))
sv_setiv(cur, 0); /* terminate next time */
RETPUSHNO;
#ifndef USE_THREADS /* don't risk potential race */
- if (SvREFCNT(*cx->blk_loop.itervar) == 1
- && !SvMAGICAL(*cx->blk_loop.itervar))
- {
+ if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
- sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+ sv_setiv(*itersvp, cx->blk_loop.iterix++);
}
else
#endif
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as they
* used to */
- SvREFCNT_dec(*cx->blk_loop.itervar);
- *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++);
+ SvREFCNT_dec(*itersvp);
+ *itersvp = newSViv(cx->blk_loop.iterix++);
}
RETPUSHYES;
}
if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
RETPUSHNO;
- SvREFCNT_dec(*cx->blk_loop.itervar);
+ SvREFCNT_dec(*itersvp);
if (sv = (SvMAGICAL(av))
? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
sv = (SV*)lv;
}
- *cx->blk_loop.itervar = SvREFCNT_inc(sv);
+ *itersvp = SvREFCNT_inc(sv);
RETPUSHYES;
}
SV *src;
ENTER; /* enter inner scope */
- SAVESPTR(PL_curpm);
+ SAVEVPTR(PL_curpm);
src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
SP--;
}
PL_stack_sp = mark + 1;
- fp3 = (I32(*)(int,int,int)))CvXSUB(cv;
+ fp3 = (I32(*)(int,int,int))CvXSUB(cv);
items = (*fp3)(CvXSUBANY(cv).any_i32,
MARK - PL_stack_base + 1,
items);
}
/* We assume first XSUB in &DB::sub is the called one. */
if (PL_curcopdb) {
- SAVESPTR(PL_curcop);
+ SAVEVPTR(PL_curcop);
PL_curcop = PL_curcopdb;
PL_curcopdb = NULL;
}
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
+ PERL_STACK_OVERFLOW_CHECK();
if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
I32 ix = AvFILLp((AV*)svp[1]);
+ I32 names_fill = AvFILLp((AV*)svp[0]);
svp = AvARRAY(svp[0]);
for ( ;ix > 0; ix--) {
- if (svp[ix] != &PL_sv_undef) {
+ if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
char *name = SvPVX(svp[ix]);
if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
|| *name == '&') /* anonymous code? */
SvPADMY_on(sv);
}
}
+ else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+ av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+ }
else {
av_store(newpad, ix, sv = NEWSV(0,0));
SvPADTMP_on(sv);
}
}
#endif /* USE_THREADS */
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
#ifndef USE_THREADS
if (hasargs)
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- packname = HvNAME(sep ? PL_curcop->cop_stash : stash);
+ packname = sep ? CopSTASHPV(PL_curcop) : HvNAME(stash);
packlen = strlen(packname);
}
else {
PP(pp_rcatline)
{
- PL_last_in_gv = cGVOP->op_gv;
+ PL_last_in_gv = cGVOP_gv;
return do_readline();
}
HV *stash = SvSTASH(SvRV(error));
GV *gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
- SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv)));
- SV *line = sv_2mortal(newSViv(PL_curcop->cop_line));
+ SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+ SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
EXTEND(SP, 3);
PUSHMARK(SP);
PUSHs(error);
SAVETMPS;
push_return(retop);
- PUSHBLOCK(cx, CXt_SUB, PL_stack_sp);
+ PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx);
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = AvARRAY((AV*)svp[1]);
setdefout(gv); /* locally select filehandle so $% et al work */
djSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
- int offset;
+ Off_t offset;
SV *bufsv;
char *buffer;
- int length;
+ Off_t length;
STRLEN blen;
MAGIC *mg;
goto say_undef;
bufsv = *++MARK;
buffer = SvPV(bufsv, blen);
+#if Off_t_SIZE > IVSIZE
+ length = SvNVx(*++MARK);
+#else
length = SvIVx(*++MARK);
+#endif
if (length < 0)
DIE(aTHX_ "Negative length");
SETERRNO(0,0);
}
else if (PL_op->op_type == OP_SYSWRITE) {
if (MARK < SP) {
+#if Off_t_SIZE > IVSIZE
+ offset = SvNVx(*++MARK);
+#else
offset = SvIVx(*++MARK);
+#endif
if (offset < 0) {
if (-offset > blen)
DIE(aTHX_ "Offset outside string");
GV *gv;
MAGIC *mg;
- if (MAXARG <= 0)
- gv = PL_last_in_gv;
+ if (MAXARG <= 0) {
+ if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */
+ IO *io;
+ gv = PL_last_in_gv = PL_argvgv;
+ io = GvIO(gv);
+ if (io && !IoIFP(io)) {
+ if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+ IoLINES(io) = 0;
+ IoFLAGS(io) &= ~IOf_START;
+ do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
+ sv_setpvn(GvSV(gv), "-", 1);
+ SvSETMAGIC(GvSV(gv));
+ }
+ else if (!nextargv(gv))
+ RETPUSHYES;
+ }
+ }
+ else
+ gv = PL_last_in_gv; /* eof */
+ }
else
- gv = PL_last_in_gv = (GV*)POPs;
+ gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */
if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
PUSHMARK(SP);
RETURN;
}
+#if LSEEKSIZE > IVSIZE
+ PUSHn( do_tell(gv) );
+#else
PUSHi( do_tell(gv) );
+#endif
RETURN;
}
djSP;
GV *gv;
int whence = POPi;
+#if LSEEKSIZE > IVSIZE
+ Off_t offset = (Off_t)SvNVx(POPs);
+#else
Off_t offset = (Off_t)SvIVx(POPs);
+#endif
MAGIC *mg;
gv = PL_last_in_gv = (GV*)POPs;
PUSHs(boolSV(do_seek(gv, offset, whence)));
else {
Off_t n = do_sysseek(gv, offset, whence);
- PUSHs((n < 0) ? &PL_sv_undef
- : sv_2mortal(n ? newSViv((IV)n)
- : newSVpvn(zero_but_true, ZBTLEN)));
+ if (n < 0)
+ PUSHs(&PL_sv_undef);
+ else {
+ SV* sv = n ?
+#if LSEEKSIZE > IVSIZE
+ newSVnv((NV)n)
+#else
+ newSViv((IV)n)
+#endif
+ : newSVpvn(zero_but_true, ZBTLEN);
+ PUSHs(sv_2mortal(sv));
+ }
}
RETURN;
}
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
- tmpgv = cGVOP->op_gv;
+ tmpgv = cGVOP_gv;
do_fstat:
if (tmpgv != PL_defgv) {
PL_laststype = OP_STAT;
PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+#if Uid_t_size > IVSIZE
+ PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
+#else
PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+#endif
+#if Gid_t_size > IVSIZE
+ PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
+#else
PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+#endif
#ifdef USE_STAT_RDEV
PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
#else
PUSHs(sv_2mortal(newSVpvn("", 0)));
#endif
+#if Off_t_size > IVSIZE
+ PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size)));
+#else
PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
+#endif
#ifdef BIG_TIME
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
djSP;
if (result < 0)
RETPUSHUNDEF;
- if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) )
+ if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
+ PL_euid : PL_uid) )
RETPUSHYES;
RETPUSHNO;
}
djSP;
if (result < 0)
RETPUSHUNDEF;
- if (!PL_statcache.st_size)
+ if (PL_statcache.st_size == 0)
RETPUSHYES;
RETPUSHNO;
}
djSP; dTARGET;
if (result < 0)
RETPUSHUNDEF;
+#if Off_t_size > IVSIZE
+ PUSHn(PL_statcache.st_size);
+#else
PUSHi(PL_statcache.st_size);
+#endif
RETURN;
}
STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
- gv = cGVOP->op_gv;
+ gv = cGVOP_gv;
else if (isGV(TOPs))
gv = (GV*)POPs;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
register SV *sv;
GV *gv;
STRLEN n_a;
+ PerlIO *fp;
if (PL_op->op_flags & OPf_REF)
- gv = cGVOP->op_gv;
+ gv = cGVOP_gv;
else if (isGV(TOPs))
gv = (GV*)POPs;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
len = 512;
}
else {
- if (ckWARN(WARN_UNOPENED))
+ if (ckWARN(WARN_UNOPENED)) {
+ gv = cGVOP_gv;
Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
- GvENAME(cGVOP->op_gv));
+ GvENAME(gv));
+ }
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
PL_statgv = Nullgv;
PL_laststatval = -1;
sv_setpv(PL_statname, SvPV(sv, n_a));
-#ifdef HAS_OPEN3
- i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
-#else
- i = PerlLIO_open(SvPV(sv, n_a), 0);
-#endif
- if (i < 0) {
+ if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
RETPUSHUNDEF;
}
- PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
- if (PL_laststatval < 0)
+ PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+ if (PL_laststatval < 0) {
+ (void)PerlIO_close(fp);
RETPUSHUNDEF;
- len = PerlLIO_read(i, tbuf, 512);
- (void)PerlLIO_close(i);
+ }
+ do_binmode(fp, '<', TRUE);
+ len = PerlIO_read(fp, tbuf, sizeof(tbuf));
+ (void)PerlIO_close(fp);
if (len <= 0) {
if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
RETPUSHNO; /* special case NFS directories */
/* now scan s to look for textiness */
/* XXX ASCII dependent code */
+#if defined(DOSISH) || defined(USEMYBINMODE)
+ /* ignore trailing ^Z on short files */
+ if (len && len < sizeof(tbuf) && tbuf[len-1] == 26)
+ --len;
+#endif
+
for (i = 0; i < len; i++, s++) {
if (!*s) { /* null never allowed in text */
odd += len;
else if (!(isPRINT(*s) || isSPACE(*s)))
odd++;
#else
- else if (*s & 128)
- odd++;
+ else if (*s & 128) {
+#ifdef USE_LOCALE
+ if (!(PL_op->op_private & OPpLOCALE) || !isALPHA_LC(*s))
+#endif
+ odd++;
+ }
else if (*s < 32 &&
*s != '\n' && *s != '\r' && *s != '\b' &&
*s != '\t' && *s != '\f' && *s != 27)
char *tmps2 = POPpx;
char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
- SETi( link(tmps, tmps2) >= 0 );
+ SETi( PerlLIO_link(tmps, tmps2) >= 0 );
#else
DIE(aTHX_ PL_no_func, "Unsupported function link");
#endif
if (!childpid) {
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
- sv_setiv(GvSV(tmpgv), (IV)getpid());
+ sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
}
PUSHi(childpid);
RETURN;
#else
+# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+ djSP; dTARGET;
+ Pid_t childpid;
+
+ EXTEND(SP, 1);
+ PERL_FLUSHALL_FOR_CHILD;
+ childpid = PerlProc_fork();
+ PUSHi(childpid);
+ RETURN;
+# else
DIE(aTHX_ PL_no_func, "Unsupported function fork");
+# endif
#endif
}
PP(pp_wait)
{
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
djSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
djSP; dTARGET;
Pid_t childpid;
int optype;
# endif
#endif
}
+
+#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+ if (value >= 0)
+ my_exit(value);
+#endif
+
SP = ORIGMARK;
PUSHi(value);
RETURN;
#ifdef BSD_GETPGRP
pgrp = (I32)BSD_GETPGRP(pid);
#else
- if (pid != 0 && pid != getpid())
+ if (pid != 0 && pid != PerlProc_getpid())
DIE(aTHX_ "POSIX getpgrp can't take an argument");
pgrp = getpgrp();
#endif
#ifdef BSD_SETPGRP
SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
#else
- if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
+ if ((pgrp != 0 && pgrp != PerlProc_getpid())
+ || (pid != 0 && pid != PerlProc_getpid()))
+ {
DIE(aTHX_ "setpgrp can't take arguments");
+ }
SETi( setpgrp() >= 0 );
#endif /* USE_BSDPGRP */
RETURN;
* and run 'make regen_headers' to effect changes.
*/
+
+
+START_EXTERN_C
+
+#if defined(PERL_IMPLICIT_SYS)
+PERL_CALLCONV PerlInterpreter* perl_alloc_using(struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p);
+#else
+PERL_CALLCONV PerlInterpreter* perl_alloc(void);
+#endif
+PERL_CALLCONV void perl_construct(PerlInterpreter* interp);
+PERL_CALLCONV void perl_destruct(PerlInterpreter* interp);
+PERL_CALLCONV void perl_free(PerlInterpreter* interp);
+PERL_CALLCONV int perl_run(PerlInterpreter* interp);
+PERL_CALLCONV int perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env);
+#if defined(USE_ITHREADS)
+PERL_CALLCONV PerlInterpreter* perl_clone(PerlInterpreter* interp, UV flags);
+# if defined(PERL_IMPLICIT_SYS)
+PERL_CALLCONV PerlInterpreter* perl_clone_using(PerlInterpreter *interp, UV flags, struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p);
+# endif
+#endif
+
+#if defined(MYMALLOC)
+PERL_CALLCONV Malloc_t Perl_malloc(MEM_SIZE nbytes);
+PERL_CALLCONV Malloc_t Perl_calloc(MEM_SIZE elements, MEM_SIZE size);
+PERL_CALLCONV Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes);
+PERL_CALLCONV Free_t Perl_mfree(Malloc_t where);
+PERL_CALLCONV MEM_SIZE Perl_malloced_size(void *p);
+#endif
+
+END_EXTERN_C
+
+/* functions with flag 'n' should come before here */
#if defined(PERL_OBJECT)
+class CPerlObj {
public:
+ struct interpreter interp;
+ CPerlObj(IPerlMem*, IPerlMem*, IPerlMem*, IPerlEnv*, IPerlStdIO*,
+ IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
+ void* operator new(size_t nSize, IPerlMem *pvtbl);
+ static void operator delete(void* pPerl, IPerlMem *pvtbl);
+ int do_aspawn (void *vreally, void **vmark, void **vsp);
#endif
-VIRTUAL SV* Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int dir);
-VIRTUAL bool Perl_Gv_AMupdate(pTHX_ HV* stash);
-VIRTUAL OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail);
-VIRTUAL OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last);
-VIRTUAL I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
-VIRTUAL bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
-VIRTUAL SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
-VIRTUAL HE* Perl_avhv_iternext(pTHX_ AV *ar);
-VIRTUAL SV* Perl_avhv_iterval(pTHX_ AV *ar, HE* entry);
-VIRTUAL HV* Perl_avhv_keys(pTHX_ AV *ar);
-VIRTUAL void Perl_av_clear(pTHX_ AV* ar);
-VIRTUAL void Perl_av_extend(pTHX_ AV* ar, I32 key);
-VIRTUAL AV* Perl_av_fake(pTHX_ I32 size, SV** svp);
-VIRTUAL SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval);
-VIRTUAL void Perl_av_fill(pTHX_ AV* ar, I32 fill);
-VIRTUAL I32 Perl_av_len(pTHX_ AV* ar);
-VIRTUAL AV* Perl_av_make(pTHX_ I32 size, SV** svp);
-VIRTUAL SV* Perl_av_pop(pTHX_ AV* ar);
-VIRTUAL void Perl_av_push(pTHX_ AV* ar, SV* val);
-VIRTUAL void Perl_av_reify(pTHX_ AV* ar);
-VIRTUAL SV* Perl_av_shift(pTHX_ AV* ar);
-VIRTUAL SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val);
-VIRTUAL void Perl_av_undef(pTHX_ AV* ar);
-VIRTUAL void Perl_av_unshift(pTHX_ AV* ar, I32 num);
-VIRTUAL OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat);
-VIRTUAL OP* Perl_block_end(pTHX_ I32 floor, OP* seq);
-VIRTUAL I32 Perl_block_gimme(pTHX);
-VIRTUAL int Perl_block_start(pTHX_ int full);
-VIRTUAL void Perl_boot_core_UNIVERSAL(pTHX);
-VIRTUAL void Perl_call_list(pTHX_ I32 oldscope, AV* av_list);
-VIRTUAL bool Perl_cando(pTHX_ Mode_t mode, Uid_t effective, Stat_t* statbufp);
-VIRTUAL U32 Perl_cast_ulong(pTHX_ NV f);
-VIRTUAL I32 Perl_cast_i32(pTHX_ NV f);
-VIRTUAL IV Perl_cast_iv(pTHX_ NV f);
-VIRTUAL UV Perl_cast_uv(pTHX_ NV f);
+#if defined(PERL_OBJECT)
+public:
+#else
+START_EXTERN_C
+#endif
+# include "pp_proto.h"
+PERL_CALLCONV SV* Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int dir);
+PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash);
+PERL_CALLCONV OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail);
+PERL_CALLCONV OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last);
+PERL_CALLCONV I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
+PERL_CALLCONV bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
+PERL_CALLCONV SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
+PERL_CALLCONV HE* Perl_avhv_iternext(pTHX_ AV *ar);
+PERL_CALLCONV SV* Perl_avhv_iterval(pTHX_ AV *ar, HE* entry);
+PERL_CALLCONV HV* Perl_avhv_keys(pTHX_ AV *ar);
+PERL_CALLCONV void Perl_av_clear(pTHX_ AV* ar);
+PERL_CALLCONV void Perl_av_extend(pTHX_ AV* ar, I32 key);
+PERL_CALLCONV AV* Perl_av_fake(pTHX_ I32 size, SV** svp);
+PERL_CALLCONV SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval);
+PERL_CALLCONV void Perl_av_fill(pTHX_ AV* ar, I32 fill);
+PERL_CALLCONV I32 Perl_av_len(pTHX_ AV* ar);
+PERL_CALLCONV AV* Perl_av_make(pTHX_ I32 size, SV** svp);
+PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV* ar);
+PERL_CALLCONV void Perl_av_push(pTHX_ AV* ar, SV* val);
+PERL_CALLCONV void Perl_av_reify(pTHX_ AV* ar);
+PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar);
+PERL_CALLCONV SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val);
+PERL_CALLCONV void Perl_av_undef(pTHX_ AV* ar);
+PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num);
+PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat);
+PERL_CALLCONV OP* Perl_block_end(pTHX_ I32 floor, OP* seq);
+PERL_CALLCONV I32 Perl_block_gimme(pTHX);
+PERL_CALLCONV int Perl_block_start(pTHX_ int full);
+PERL_CALLCONV void Perl_boot_core_UNIVERSAL(pTHX);
+PERL_CALLCONV void Perl_call_list(pTHX_ I32 oldscope, AV* av_list);
+PERL_CALLCONV bool Perl_cando(pTHX_ Mode_t mode, Uid_t effective, Stat_t* statbufp);
+PERL_CALLCONV U32 Perl_cast_ulong(pTHX_ NV f);
+PERL_CALLCONV I32 Perl_cast_i32(pTHX_ NV f);
+PERL_CALLCONV IV Perl_cast_iv(pTHX_ NV f);
+PERL_CALLCONV UV Perl_cast_uv(pTHX_ NV f);
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
-VIRTUAL I32 Perl_my_chsize(pTHX_ int fd, Off_t length);
+PERL_CALLCONV I32 Perl_my_chsize(pTHX_ int fd, Off_t length);
#endif
#if defined(USE_THREADS)
-VIRTUAL MAGIC* Perl_condpair_magic(pTHX_ SV *sv);
+PERL_CALLCONV MAGIC* Perl_condpair_magic(pTHX_ SV *sv);
#endif
-VIRTUAL OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o);
-VIRTUAL void Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn));
-VIRTUAL void Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__((noreturn));
+PERL_CALLCONV OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o);
+PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn));
+PERL_CALLCONV void Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__((noreturn));
#if defined(PERL_IMPLICIT_CONTEXT)
-VIRTUAL void Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn));
-VIRTUAL OP* Perl_die_nocontext(const char* pat, ...);
-VIRTUAL void Perl_deb_nocontext(const char* pat, ...);
-VIRTUAL char* Perl_form_nocontext(const char* pat, ...);
-VIRTUAL SV* Perl_mess_nocontext(const char* pat, ...);
-VIRTUAL void Perl_warn_nocontext(const char* pat, ...);
-VIRTUAL void Perl_warner_nocontext(U32 err, const char* pat, ...);
-VIRTUAL SV* Perl_newSVpvf_nocontext(const char* pat, ...);
-VIRTUAL void Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...);
-VIRTUAL void Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...);
-VIRTUAL void Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...);
-VIRTUAL void Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...);
-VIRTUAL int Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...);
+PERL_CALLCONV void Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn));
+PERL_CALLCONV OP* Perl_die_nocontext(const char* pat, ...);
+PERL_CALLCONV void Perl_deb_nocontext(const char* pat, ...);
+PERL_CALLCONV char* Perl_form_nocontext(const char* pat, ...);
+PERL_CALLCONV SV* Perl_mess_nocontext(const char* pat, ...);
+PERL_CALLCONV void Perl_warn_nocontext(const char* pat, ...);
+PERL_CALLCONV void Perl_warner_nocontext(U32 err, const char* pat, ...);
+PERL_CALLCONV SV* Perl_newSVpvf_nocontext(const char* pat, ...);
+PERL_CALLCONV void Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...);
+PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...);
#endif
-VIRTUAL void Perl_cv_ckproto(pTHX_ CV* cv, GV* gv, char* p);
-VIRTUAL CV* Perl_cv_clone(pTHX_ CV* proto);
-VIRTUAL SV* Perl_cv_const_sv(pTHX_ CV* cv);
-VIRTUAL SV* Perl_op_const_sv(pTHX_ OP* o, CV* cv);
-VIRTUAL void Perl_cv_undef(pTHX_ CV* cv);
-VIRTUAL void Perl_cx_dump(pTHX_ PERL_CONTEXT* cs);
-VIRTUAL SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv);
-VIRTUAL void Perl_filter_del(pTHX_ filter_t funcp);
-VIRTUAL I32 Perl_filter_read(pTHX_ int idx, SV* buffer, int maxlen);
-VIRTUAL char** Perl_get_op_descs(pTHX);
-VIRTUAL char** Perl_get_op_names(pTHX);
-VIRTUAL char* Perl_get_no_modify(pTHX);
-VIRTUAL U32* Perl_get_opargs(pTHX);
-VIRTUAL PPADDR_t* Perl_get_ppaddr(pTHX);
-VIRTUAL I32 Perl_cxinc(pTHX);
-VIRTUAL void Perl_deb(pTHX_ const char* pat, ...);
-VIRTUAL void Perl_vdeb(pTHX_ const char* pat, va_list* args);
-VIRTUAL void Perl_deb_growlevel(pTHX);
-VIRTUAL void Perl_debprofdump(pTHX);
-VIRTUAL I32 Perl_debop(pTHX_ OP* o);
-VIRTUAL I32 Perl_debstack(pTHX);
-VIRTUAL I32 Perl_debstackptrs(pTHX);
-VIRTUAL char* Perl_delimcpy(pTHX_ char* to, char* toend, char* from, char* fromend, int delim, I32* retlen);
-VIRTUAL void Perl_deprecate(pTHX_ char* s);
-VIRTUAL OP* Perl_die(pTHX_ const char* pat, ...);
-VIRTUAL OP* Perl_vdie(pTHX_ const char* pat, va_list* args);
-VIRTUAL OP* Perl_die_where(pTHX_ char* message, STRLEN msglen);
-VIRTUAL void Perl_dounwind(pTHX_ I32 cxix);
-VIRTUAL bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp);
-VIRTUAL bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int flag);
-VIRTUAL int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag);
-VIRTUAL void Perl_do_chop(pTHX_ SV* asv, SV* sv);
-VIRTUAL bool Perl_do_close(pTHX_ GV* gv, bool not_implicit);
-VIRTUAL bool Perl_do_eof(pTHX_ GV* gv);
-VIRTUAL bool Perl_do_exec(pTHX_ char* cmd);
+PERL_CALLCONV void Perl_cv_ckproto(pTHX_ CV* cv, GV* gv, char* p);
+PERL_CALLCONV CV* Perl_cv_clone(pTHX_ CV* proto);
+PERL_CALLCONV SV* Perl_cv_const_sv(pTHX_ CV* cv);
+PERL_CALLCONV SV* Perl_op_const_sv(pTHX_ OP* o, CV* cv);
+PERL_CALLCONV void Perl_cv_undef(pTHX_ CV* cv);
+PERL_CALLCONV void Perl_cx_dump(pTHX_ PERL_CONTEXT* cs);
+PERL_CALLCONV SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv);
+PERL_CALLCONV void Perl_filter_del(pTHX_ filter_t funcp);
+PERL_CALLCONV I32 Perl_filter_read(pTHX_ int idx, SV* buffer, int maxlen);
+PERL_CALLCONV char** Perl_get_op_descs(pTHX);
+PERL_CALLCONV char** Perl_get_op_names(pTHX);
+PERL_CALLCONV char* Perl_get_no_modify(pTHX);
+PERL_CALLCONV U32* Perl_get_opargs(pTHX);
+PERL_CALLCONV PPADDR_t* Perl_get_ppaddr(pTHX);
+PERL_CALLCONV I32 Perl_cxinc(pTHX);
+PERL_CALLCONV void Perl_deb(pTHX_ const char* pat, ...);
+PERL_CALLCONV void Perl_vdeb(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV void Perl_debprofdump(pTHX);
+PERL_CALLCONV I32 Perl_debop(pTHX_ OP* o);
+PERL_CALLCONV I32 Perl_debstack(pTHX);
+PERL_CALLCONV I32 Perl_debstackptrs(pTHX);
+PERL_CALLCONV char* Perl_delimcpy(pTHX_ char* to, char* toend, char* from, char* fromend, int delim, I32* retlen);
+PERL_CALLCONV void Perl_deprecate(pTHX_ char* s);
+PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...);
+PERL_CALLCONV OP* Perl_vdie(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV OP* Perl_die_where(pTHX_ char* message, STRLEN msglen);
+PERL_CALLCONV void Perl_dounwind(pTHX_ I32 cxix);
+PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp);
+PERL_CALLCONV bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int flag);
+PERL_CALLCONV int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag);
+PERL_CALLCONV void Perl_do_chop(pTHX_ SV* asv, SV* sv);
+PERL_CALLCONV bool Perl_do_close(pTHX_ GV* gv, bool not_implicit);
+PERL_CALLCONV bool Perl_do_eof(pTHX_ GV* gv);
+PERL_CALLCONV bool Perl_do_exec(pTHX_ char* cmd);
#if !defined(WIN32)
-VIRTUAL bool Perl_do_exec3(pTHX_ char* cmd, int fd, int flag);
+PERL_CALLCONV bool Perl_do_exec3(pTHX_ char* cmd, int fd, int flag);
#endif
-VIRTUAL void Perl_do_execfree(pTHX);
+PERL_CALLCONV void Perl_do_execfree(pTHX);
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-VIRTUAL I32 Perl_do_ipcctl(pTHX_ I32 optype, SV** mark, SV** sp);
-VIRTUAL I32 Perl_do_ipcget(pTHX_ I32 optype, SV** mark, SV** sp);
-VIRTUAL I32 Perl_do_msgrcv(pTHX_ SV** mark, SV** sp);
-VIRTUAL I32 Perl_do_msgsnd(pTHX_ SV** mark, SV** sp);
-VIRTUAL I32 Perl_do_semop(pTHX_ SV** mark, SV** sp);
-VIRTUAL I32 Perl_do_shmio(pTHX_ I32 optype, SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_ipcctl(pTHX_ I32 optype, SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_ipcget(pTHX_ I32 optype, SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_msgrcv(pTHX_ SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_msgsnd(pTHX_ SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_semop(pTHX_ SV** mark, SV** sp);
+PERL_CALLCONV I32 Perl_do_shmio(pTHX_ I32 optype, SV** mark, SV** sp);
#endif
-VIRTUAL void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp);
-VIRTUAL OP* Perl_do_kv(pTHX);
-VIRTUAL bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp);
-VIRTUAL bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num);
-VIRTUAL void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv);
-VIRTUAL bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp);
-VIRTUAL OP* Perl_do_readline(pTHX);
-VIRTUAL I32 Perl_do_chomp(pTHX_ SV* sv);
-VIRTUAL bool Perl_do_seek(pTHX_ GV* gv, Off_t pos, int whence);
-VIRTUAL void Perl_do_sprintf(pTHX_ SV* sv, I32 len, SV** sarg);
-VIRTUAL Off_t Perl_do_sysseek(pTHX_ GV* gv, Off_t pos, int whence);
-VIRTUAL Off_t Perl_do_tell(pTHX_ GV* gv);
-VIRTUAL I32 Perl_do_trans(pTHX_ SV* sv);
-VIRTUAL UV Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size);
-VIRTUAL void Perl_do_vecset(pTHX_ SV* sv);
-VIRTUAL void Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right);
-VIRTUAL OP* Perl_dofile(pTHX_ OP* term);
-VIRTUAL I32 Perl_dowantarray(pTHX);
-VIRTUAL void Perl_dump_all(pTHX);
-VIRTUAL void Perl_dump_eval(pTHX);
+PERL_CALLCONV void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp);
+PERL_CALLCONV OP* Perl_do_kv(pTHX);
+PERL_CALLCONV bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp);
+PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num);
+PERL_CALLCONV void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv);
+PERL_CALLCONV bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp);
+PERL_CALLCONV OP* Perl_do_readline(pTHX);
+PERL_CALLCONV I32 Perl_do_chomp(pTHX_ SV* sv);
+PERL_CALLCONV bool Perl_do_seek(pTHX_ GV* gv, Off_t pos, int whence);
+PERL_CALLCONV void Perl_do_sprintf(pTHX_ SV* sv, I32 len, SV** sarg);
+PERL_CALLCONV Off_t Perl_do_sysseek(pTHX_ GV* gv, Off_t pos, int whence);
+PERL_CALLCONV Off_t Perl_do_tell(pTHX_ GV* gv);
+PERL_CALLCONV I32 Perl_do_trans(pTHX_ SV* sv);
+PERL_CALLCONV UV Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size);
+PERL_CALLCONV void Perl_do_vecset(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right);
+PERL_CALLCONV OP* Perl_dofile(pTHX_ OP* term);
+PERL_CALLCONV I32 Perl_dowantarray(pTHX);
+PERL_CALLCONV void Perl_dump_all(pTHX);
+PERL_CALLCONV void Perl_dump_eval(pTHX);
#if defined(DUMP_FDS)
-VIRTUAL void Perl_dump_fds(pTHX_ char* s);
+PERL_CALLCONV void Perl_dump_fds(pTHX_ char* s);
#endif
-VIRTUAL void Perl_dump_form(pTHX_ GV* gv);
-VIRTUAL void Perl_gv_dump(pTHX_ GV* gv);
-VIRTUAL void Perl_op_dump(pTHX_ OP* arg);
-VIRTUAL void Perl_pmop_dump(pTHX_ PMOP* pm);
-VIRTUAL void Perl_dump_packsubs(pTHX_ HV* stash);
-VIRTUAL void Perl_dump_sub(pTHX_ GV* gv);
-VIRTUAL void Perl_fbm_compile(pTHX_ SV* sv, U32 flags);
-VIRTUAL char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags);
-VIRTUAL char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags);
+PERL_CALLCONV void Perl_dump_form(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_gv_dump(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_op_dump(pTHX_ OP* arg);
+PERL_CALLCONV void Perl_pmop_dump(pTHX_ PMOP* pm);
+PERL_CALLCONV void Perl_dump_packsubs(pTHX_ HV* stash);
+PERL_CALLCONV void Perl_dump_sub(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_fbm_compile(pTHX_ SV* sv, U32 flags);
+PERL_CALLCONV char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags);
+PERL_CALLCONV char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags);
#if defined(USE_THREADS)
-VIRTUAL PADOFFSET Perl_find_threadsv(pTHX_ const char *name);
+PERL_CALLCONV PADOFFSET Perl_find_threadsv(pTHX_ const char *name);
#endif
-VIRTUAL OP* Perl_force_list(pTHX_ OP* arg);
-VIRTUAL OP* Perl_fold_constants(pTHX_ OP* arg);
-VIRTUAL char* Perl_form(pTHX_ const char* pat, ...);
-VIRTUAL char* Perl_vform(pTHX_ const char* pat, va_list* args);
-VIRTUAL void Perl_free_tmps(pTHX);
-VIRTUAL OP* Perl_gen_constant_list(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_force_list(pTHX_ OP* arg);
+PERL_CALLCONV OP* Perl_fold_constants(pTHX_ OP* arg);
+PERL_CALLCONV char* Perl_form(pTHX_ const char* pat, ...);
+PERL_CALLCONV char* Perl_vform(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV void Perl_free_tmps(pTHX);
+PERL_CALLCONV OP* Perl_gen_constant_list(pTHX_ OP* o);
#if !defined(HAS_GETENV_LEN)
-VIRTUAL char* Perl_getenv_len(pTHX_ char* key, unsigned long *len);
+PERL_CALLCONV char* Perl_getenv_len(pTHX_ char* key, unsigned long *len);
#endif
-VIRTUAL void Perl_gp_free(pTHX_ GV* gv);
-VIRTUAL GP* Perl_gp_ref(pTHX_ GP* gp);
-VIRTUAL GV* Perl_gv_AVadd(pTHX_ GV* gv);
-VIRTUAL GV* Perl_gv_HVadd(pTHX_ GV* gv);
-VIRTUAL GV* Perl_gv_IOadd(pTHX_ GV* gv);
-VIRTUAL GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method);
-VIRTUAL void Perl_gv_check(pTHX_ HV* stash);
-VIRTUAL void Perl_gv_efullname(pTHX_ SV* sv, GV* gv);
-VIRTUAL void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
-VIRTUAL GV* Perl_gv_fetchfile(pTHX_ const char* name);
-VIRTUAL GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level);
-VIRTUAL GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name);
-VIRTUAL GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload);
-VIRTUAL GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type);
-VIRTUAL void Perl_gv_fullname(pTHX_ SV* sv, GV* gv);
-VIRTUAL void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
-VIRTUAL void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi);
-VIRTUAL HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create);
-VIRTUAL HV* Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create);
-VIRTUAL HV* Perl_gv_stashsv(pTHX_ SV* sv, I32 create);
-VIRTUAL void Perl_hv_clear(pTHX_ HV* tb);
-VIRTUAL void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry);
-VIRTUAL SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, U32 klen, I32 flags);
-VIRTUAL SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash);
-VIRTUAL bool Perl_hv_exists(pTHX_ HV* tb, const char* key, U32 klen);
-VIRTUAL bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash);
-VIRTUAL SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, U32 klen, I32 lval);
-VIRTUAL HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash);
-VIRTUAL void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry);
-VIRTUAL I32 Perl_hv_iterinit(pTHX_ HV* tb);
-VIRTUAL char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen);
-VIRTUAL SV* Perl_hv_iterkeysv(pTHX_ HE* entry);
-VIRTUAL HE* Perl_hv_iternext(pTHX_ HV* tb);
-VIRTUAL SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen);
-VIRTUAL SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry);
-VIRTUAL void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax);
-VIRTUAL void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how);
-VIRTUAL SV** Perl_hv_store(pTHX_ HV* tb, const char* key, U32 klen, SV* val, U32 hash);
-VIRTUAL HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash);
-VIRTUAL void Perl_hv_undef(pTHX_ HV* tb);
-VIRTUAL I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
-VIRTUAL I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len);
-VIRTUAL bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective);
-VIRTUAL void Perl_init_debugger(pTHX);
-VIRTUAL void Perl_init_stacks(pTHX);
-VIRTUAL U32 Perl_intro_my(pTHX);
-VIRTUAL char* Perl_instr(pTHX_ const char* big, const char* little);
-VIRTUAL bool Perl_io_close(pTHX_ IO* io, bool not_implicit);
-VIRTUAL OP* Perl_invert(pTHX_ OP* cmd);
-VIRTUAL bool Perl_is_uni_alnum(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_alnumc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_idfirst(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_alpha(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_ascii(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_space(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_cntrl(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_graph(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_digit(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_upper(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_lower(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_print(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_punct(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_xdigit(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_upper(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_title(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_lower(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_alnum_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_alnumc_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_idfirst_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_alpha_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_ascii_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_space_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_cntrl_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_graph_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_digit_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_upper_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_lower_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_print_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_punct_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_uni_xdigit_lc(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_upper_lc(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_title_lc(pTHX_ U32 c);
-VIRTUAL U32 Perl_to_uni_lower_lc(pTHX_ U32 c);
-VIRTUAL bool Perl_is_utf8_alnum(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_alnumc(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_idfirst(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_alpha(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_ascii(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_space(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_cntrl(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_digit(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_graph(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_upper(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_lower(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_print(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_punct(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_xdigit(pTHX_ U8 *p);
-VIRTUAL bool Perl_is_utf8_mark(pTHX_ U8 *p);
-VIRTUAL OP* Perl_jmaybe(pTHX_ OP* arg);
-VIRTUAL I32 Perl_keyword(pTHX_ char* d, I32 len);
-VIRTUAL void Perl_leave_scope(pTHX_ I32 base);
-VIRTUAL void Perl_lex_end(pTHX);
-VIRTUAL void Perl_lex_start(pTHX_ SV* line);
-VIRTUAL OP* Perl_linklist(pTHX_ OP* o);
-VIRTUAL OP* Perl_list(pTHX_ OP* o);
-VIRTUAL OP* Perl_listkids(pTHX_ OP* o);
-VIRTUAL OP* Perl_localize(pTHX_ OP* arg, I32 lexical);
-VIRTUAL I32 Perl_looks_like_number(pTHX_ SV* sv);
-VIRTUAL int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_clearsig(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_existspack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_get(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getarylen(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getdefelem(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getglob(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getnkeys(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getpack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getpos(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getsig(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getsubstr(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_gettaint(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getuvar(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_getvec(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL U32 Perl_magic_len(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv);
+PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp);
+PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV* gv);
+PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV* gv);
+PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv);
+PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method);
+PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash);
+PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, GV* gv);
+PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
+PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name);
+PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level);
+PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name);
+PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload);
+PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type);
+PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv);
+PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
+PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi);
+PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create);
+PERL_CALLCONV HV* Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create);
+PERL_CALLCONV HV* Perl_gv_stashsv(pTHX_ SV* sv, I32 create);
+PERL_CALLCONV void Perl_hv_clear(pTHX_ HV* tb);
+PERL_CALLCONV void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry);
+PERL_CALLCONV SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, U32 klen, I32 flags);
+PERL_CALLCONV SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash);
+PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, U32 klen);
+PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash);
+PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, U32 klen, I32 lval);
+PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash);
+PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry);
+PERL_CALLCONV I32 Perl_hv_iterinit(pTHX_ HV* tb);
+PERL_CALLCONV char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen);
+PERL_CALLCONV SV* Perl_hv_iterkeysv(pTHX_ HE* entry);
+PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb);
+PERL_CALLCONV SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen);
+PERL_CALLCONV SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry);
+PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax);
+PERL_CALLCONV void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how);
+PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, U32 klen, SV* val, U32 hash);
+PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash);
+PERL_CALLCONV void Perl_hv_undef(pTHX_ HV* tb);
+PERL_CALLCONV I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
+PERL_CALLCONV I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len);
+PERL_CALLCONV bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective);
+PERL_CALLCONV void Perl_init_debugger(pTHX);
+PERL_CALLCONV void Perl_init_stacks(pTHX);
+PERL_CALLCONV U32 Perl_intro_my(pTHX);
+PERL_CALLCONV char* Perl_instr(pTHX_ const char* big, const char* little);
+PERL_CALLCONV bool Perl_io_close(pTHX_ IO* io, bool not_implicit);
+PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd);
+PERL_CALLCONV bool Perl_is_uni_alnum(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_alnumc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_idfirst(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_alpha(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_ascii(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_space(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_cntrl(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_graph(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_digit(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_upper(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_lower(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_print(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_punct(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_xdigit(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_upper(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_title(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_lower(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_alnum_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_alnumc_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_idfirst_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_alpha_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_ascii_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_space_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_cntrl_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_graph_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_digit_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_upper_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_lower_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_print_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_punct_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_uni_xdigit_lc(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_upper_lc(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c);
+PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_alnumc(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_alpha(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_ascii(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_space(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_cntrl(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_digit(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_graph(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_upper(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_lower(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_print(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_punct(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_xdigit(pTHX_ U8 *p);
+PERL_CALLCONV bool Perl_is_utf8_mark(pTHX_ U8 *p);
+PERL_CALLCONV OP* Perl_jmaybe(pTHX_ OP* arg);
+PERL_CALLCONV I32 Perl_keyword(pTHX_ char* d, I32 len);
+PERL_CALLCONV void Perl_leave_scope(pTHX_ I32 base);
+PERL_CALLCONV void Perl_lex_end(pTHX);
+PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line);
+PERL_CALLCONV OP* Perl_linklist(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_list(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_listkids(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_localize(pTHX_ OP* arg, I32 lexical);
+PERL_CALLCONV I32 Perl_looks_like_number(pTHX_ SV* sv);
+PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_clearsig(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_get(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getarylen(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getdefelem(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getglob(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getnkeys(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getpack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getpos(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getsig(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getsubstr(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_gettaint(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getuvar(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_getvec(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV U32 Perl_magic_len(pTHX_ SV* sv, MAGIC* mg);
#if defined(USE_THREADS)
-VIRTUAL int Perl_magic_mutexfree(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_mutexfree(pTHX_ SV* sv, MAGIC* mg);
#endif
-VIRTUAL int Perl_magic_nextpack(pTHX_ SV* sv, MAGIC* mg, SV* key);
-VIRTUAL U32 Perl_magic_regdata_cnt(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_set(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setamagic(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setarylen(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setbm(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_nextpack(pTHX_ SV* sv, MAGIC* mg, SV* key);
+PERL_CALLCONV U32 Perl_magic_regdata_cnt(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_set(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setamagic(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setarylen(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setbm(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg);
#if defined(USE_LOCALE_COLLATE)
-VIRTUAL int Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg);
-#endif
-VIRTUAL int Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setisa(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setmglob(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setpos(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_settaint(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setuvar(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_set_all_env(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL U32 Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg);
-VIRTUAL void Perl_magicname(pTHX_ char* sym, char* name, I32 namlen);
-#if defined(MYMALLOC)
-VIRTUAL MEM_SIZE Perl_malloced_size(void *p);
+PERL_CALLCONV int Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg);
#endif
-VIRTUAL void Perl_markstack_grow(pTHX);
+PERL_CALLCONV int Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setisa(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setmglob(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setpos(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_settaint(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setuvar(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_set_all_env(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV U32 Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg);
+PERL_CALLCONV void Perl_magicname(pTHX_ char* sym, char* name, I32 namlen);
+PERL_CALLCONV void Perl_markstack_grow(pTHX);
#if defined(USE_LOCALE_COLLATE)
-VIRTUAL char* Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen);
+PERL_CALLCONV char* Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen);
#endif
-VIRTUAL SV* Perl_mess(pTHX_ const char* pat, ...);
-VIRTUAL SV* Perl_vmess(pTHX_ const char* pat, va_list* args);
-VIRTUAL void Perl_qerror(pTHX_ SV* err);
-VIRTUAL int Perl_mg_clear(pTHX_ SV* sv);
-VIRTUAL int Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen);
-VIRTUAL MAGIC* Perl_mg_find(pTHX_ SV* sv, int type);
-VIRTUAL int Perl_mg_free(pTHX_ SV* sv);
-VIRTUAL int Perl_mg_get(pTHX_ SV* sv);
-VIRTUAL U32 Perl_mg_length(pTHX_ SV* sv);
-VIRTUAL void Perl_mg_magical(pTHX_ SV* sv);
-VIRTUAL int Perl_mg_set(pTHX_ SV* sv);
-VIRTUAL I32 Perl_mg_size(pTHX_ SV* sv);
-VIRTUAL OP* Perl_mod(pTHX_ OP* o, I32 type);
-VIRTUAL char* Perl_moreswitches(pTHX_ char* s);
-VIRTUAL OP* Perl_my(pTHX_ OP* o);
-VIRTUAL NV Perl_my_atof(pTHX_ const char *s);
+PERL_CALLCONV SV* Perl_mess(pTHX_ const char* pat, ...);
+PERL_CALLCONV SV* Perl_vmess(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV void Perl_qerror(pTHX_ SV* err);
+PERL_CALLCONV int Perl_mg_clear(pTHX_ SV* sv);
+PERL_CALLCONV int Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen);
+PERL_CALLCONV MAGIC* Perl_mg_find(pTHX_ SV* sv, int type);
+PERL_CALLCONV int Perl_mg_free(pTHX_ SV* sv);
+PERL_CALLCONV int Perl_mg_get(pTHX_ SV* sv);
+PERL_CALLCONV U32 Perl_mg_length(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_mg_magical(pTHX_ SV* sv);
+PERL_CALLCONV int Perl_mg_set(pTHX_ SV* sv);
+PERL_CALLCONV I32 Perl_mg_size(pTHX_ SV* sv);
+PERL_CALLCONV OP* Perl_mod(pTHX_ OP* o, I32 type);
+PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s);
+PERL_CALLCONV OP* Perl_my(pTHX_ OP* o);
+PERL_CALLCONV NV Perl_my_atof(pTHX_ const char *s);
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
-VIRTUAL char* Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len);
+PERL_CALLCONV char* Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len);
#endif
#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
-VIRTUAL char* Perl_my_bzero(pTHX_ char* loc, I32 len);
+PERL_CALLCONV char* Perl_my_bzero(pTHX_ char* loc, I32 len);
#endif
-VIRTUAL void Perl_my_exit(pTHX_ U32 status) __attribute__((noreturn));
-VIRTUAL void Perl_my_failure_exit(pTHX) __attribute__((noreturn));
-VIRTUAL I32 Perl_my_fflush_all(pTHX);
-VIRTUAL I32 Perl_my_lstat(pTHX);
+PERL_CALLCONV void Perl_my_exit(pTHX_ U32 status) __attribute__((noreturn));
+PERL_CALLCONV void Perl_my_failure_exit(pTHX) __attribute__((noreturn));
+PERL_CALLCONV I32 Perl_my_fflush_all(pTHX);
+PERL_CALLCONV I32 Perl_my_lstat(pTHX);
#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
-VIRTUAL I32 Perl_my_memcmp(pTHX_ const char* s1, const char* s2, I32 len);
+PERL_CALLCONV I32 Perl_my_memcmp(pTHX_ const char* s1, const char* s2, I32 len);
#endif
#if !defined(HAS_MEMSET)
-VIRTUAL void* Perl_my_memset(pTHX_ char* loc, I32 ch, I32 len);
+PERL_CALLCONV void* Perl_my_memset(pTHX_ char* loc, I32 ch, I32 len);
#endif
#if !defined(PERL_OBJECT)
-VIRTUAL I32 Perl_my_pclose(pTHX_ PerlIO* ptr);
-VIRTUAL PerlIO* Perl_my_popen(pTHX_ char* cmd, char* mode);
+PERL_CALLCONV I32 Perl_my_pclose(pTHX_ PerlIO* ptr);
+PERL_CALLCONV PerlIO* Perl_my_popen(pTHX_ char* cmd, char* mode);
#endif
-VIRTUAL void Perl_my_setenv(pTHX_ char* nam, char* val);
-VIRTUAL I32 Perl_my_stat(pTHX);
+PERL_CALLCONV void Perl_my_setenv(pTHX_ char* nam, char* val);
+PERL_CALLCONV I32 Perl_my_stat(pTHX);
#if defined(MYSWAP)
-VIRTUAL short Perl_my_swap(pTHX_ short s);
-VIRTUAL long Perl_my_htonl(pTHX_ long l);
-VIRTUAL long Perl_my_ntohl(pTHX_ long l);
+PERL_CALLCONV short Perl_my_swap(pTHX_ short s);
+PERL_CALLCONV long Perl_my_htonl(pTHX_ long l);
+PERL_CALLCONV long Perl_my_ntohl(pTHX_ long l);
#endif
-VIRTUAL void Perl_my_unexec(pTHX);
-VIRTUAL OP* Perl_newANONLIST(pTHX_ OP* o);
-VIRTUAL OP* Perl_newANONHASH(pTHX_ OP* o);
-VIRTUAL OP* Perl_newANONSUB(pTHX_ I32 floor, OP* proto, OP* block);
-VIRTUAL OP* Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* right);
-VIRTUAL OP* Perl_newCONDOP(pTHX_ I32 flags, OP* expr, OP* trueop, OP* falseop);
-VIRTUAL void Perl_newCONSTSUB(pTHX_ HV* stash, char* name, SV* sv);
-VIRTUAL void Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block);
-VIRTUAL OP* Perl_newFOROP(pTHX_ I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont);
-VIRTUAL OP* Perl_newLOGOP(pTHX_ I32 optype, I32 flags, OP* left, OP* right);
-VIRTUAL OP* Perl_newLOOPEX(pTHX_ I32 type, OP* label);
-VIRTUAL OP* Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP* expr, OP* block);
-VIRTUAL OP* Perl_newNULLLIST(pTHX);
-VIRTUAL OP* Perl_newOP(pTHX_ I32 optype, I32 flags);
-VIRTUAL void Perl_newPROG(pTHX_ OP* o);
-VIRTUAL OP* Perl_newRANGE(pTHX_ I32 flags, OP* left, OP* right);
-VIRTUAL OP* Perl_newSLICEOP(pTHX_ I32 flags, OP* subscript, OP* listop);
-VIRTUAL OP* Perl_newSTATEOP(pTHX_ I32 flags, char* label, OP* o);
-VIRTUAL CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
-VIRTUAL CV* Perl_newXS(pTHX_ char* name, XSUBADDR_t f, char* filename);
-VIRTUAL AV* Perl_newAV(pTHX);
-VIRTUAL OP* Perl_newAVREF(pTHX_ OP* o);
-VIRTUAL OP* Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last);
-VIRTUAL OP* Perl_newCVREF(pTHX_ I32 flags, OP* o);
-VIRTUAL OP* Perl_newGVOP(pTHX_ I32 type, I32 flags, GV* gv);
-VIRTUAL GV* Perl_newGVgen(pTHX_ char* pack);
-VIRTUAL OP* Perl_newGVREF(pTHX_ I32 type, OP* o);
-VIRTUAL OP* Perl_newHVREF(pTHX_ OP* o);
-VIRTUAL HV* Perl_newHV(pTHX);
-VIRTUAL HV* Perl_newHVhv(pTHX_ HV* hv);
-VIRTUAL IO* Perl_newIO(pTHX);
-VIRTUAL OP* Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last);
-VIRTUAL OP* Perl_newPMOP(pTHX_ I32 type, I32 flags);
-VIRTUAL OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv);
-VIRTUAL SV* Perl_newRV(pTHX_ SV* pref);
-VIRTUAL SV* Perl_newRV_noinc(pTHX_ SV *sv);
-VIRTUAL SV* Perl_newSV(pTHX_ STRLEN len);
-VIRTUAL OP* Perl_newSVREF(pTHX_ OP* o);
-VIRTUAL OP* Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv);
-VIRTUAL SV* Perl_newSViv(pTHX_ IV i);
-VIRTUAL SV* Perl_newSVnv(pTHX_ NV n);
-VIRTUAL SV* Perl_newSVpv(pTHX_ const char* s, STRLEN len);
-VIRTUAL SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len);
-VIRTUAL SV* Perl_newSVpvf(pTHX_ const char* pat, ...);
-VIRTUAL SV* Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args);
-VIRTUAL SV* Perl_newSVrv(pTHX_ SV* rv, const char* classname);
-VIRTUAL SV* Perl_newSVsv(pTHX_ SV* old);
-VIRTUAL OP* Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first);
-VIRTUAL OP* Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont);
-VIRTUAL PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems);
-VIRTUAL PerlIO* Perl_nextargv(pTHX_ GV* gv);
-VIRTUAL char* Perl_ninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend);
-VIRTUAL OP* Perl_oopsCV(pTHX_ OP* o);
-VIRTUAL void Perl_op_free(pTHX_ OP* arg);
-VIRTUAL void Perl_package(pTHX_ OP* o);
-VIRTUAL PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype);
-VIRTUAL PADOFFSET Perl_pad_allocmy(pTHX_ char* name);
-VIRTUAL PADOFFSET Perl_pad_findmy(pTHX_ char* name);
-VIRTUAL OP* Perl_oopsAV(pTHX_ OP* o);
-VIRTUAL OP* Perl_oopsHV(pTHX_ OP* o);
-VIRTUAL void Perl_pad_leavemy(pTHX_ I32 fill);
-VIRTUAL SV* Perl_pad_sv(pTHX_ PADOFFSET po);
-VIRTUAL void Perl_pad_free(pTHX_ PADOFFSET po);
-VIRTUAL void Perl_pad_reset(pTHX);
-VIRTUAL void Perl_pad_swipe(pTHX_ PADOFFSET po);
-VIRTUAL void Perl_peep(pTHX_ OP* o);
+PERL_CALLCONV void Perl_my_unexec(pTHX);
+PERL_CALLCONV OP* Perl_newANONLIST(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_newANONHASH(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_newANONSUB(pTHX_ I32 floor, OP* proto, OP* block);
+PERL_CALLCONV OP* Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* right);
+PERL_CALLCONV OP* Perl_newCONDOP(pTHX_ I32 flags, OP* expr, OP* trueop, OP* falseop);
+PERL_CALLCONV void Perl_newCONSTSUB(pTHX_ HV* stash, char* name, SV* sv);
+PERL_CALLCONV void Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block);
+PERL_CALLCONV OP* Perl_newFOROP(pTHX_ I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont);
+PERL_CALLCONV OP* Perl_newLOGOP(pTHX_ I32 optype, I32 flags, OP* left, OP* right);
+PERL_CALLCONV OP* Perl_newLOOPEX(pTHX_ I32 type, OP* label);
+PERL_CALLCONV OP* Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP* expr, OP* block);
+PERL_CALLCONV OP* Perl_newNULLLIST(pTHX);
+PERL_CALLCONV OP* Perl_newOP(pTHX_ I32 optype, I32 flags);
+PERL_CALLCONV void Perl_newPROG(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_newRANGE(pTHX_ I32 flags, OP* left, OP* right);
+PERL_CALLCONV OP* Perl_newSLICEOP(pTHX_ I32 flags, OP* subscript, OP* listop);
+PERL_CALLCONV OP* Perl_newSTATEOP(pTHX_ I32 flags, char* label, OP* o);
+PERL_CALLCONV CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
+PERL_CALLCONV CV* Perl_newXS(pTHX_ char* name, XSUBADDR_t f, char* filename);
+PERL_CALLCONV AV* Perl_newAV(pTHX);
+PERL_CALLCONV OP* Perl_newAVREF(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last);
+PERL_CALLCONV OP* Perl_newCVREF(pTHX_ I32 flags, OP* o);
+PERL_CALLCONV OP* Perl_newGVOP(pTHX_ I32 type, I32 flags, GV* gv);
+PERL_CALLCONV GV* Perl_newGVgen(pTHX_ char* pack);
+PERL_CALLCONV OP* Perl_newGVREF(pTHX_ I32 type, OP* o);
+PERL_CALLCONV OP* Perl_newHVREF(pTHX_ OP* o);
+PERL_CALLCONV HV* Perl_newHV(pTHX);
+PERL_CALLCONV HV* Perl_newHVhv(pTHX_ HV* hv);
+PERL_CALLCONV IO* Perl_newIO(pTHX);
+PERL_CALLCONV OP* Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last);
+PERL_CALLCONV OP* Perl_newPADOP(pTHX_ I32 type, I32 flags, SV* sv);
+PERL_CALLCONV OP* Perl_newPMOP(pTHX_ I32 type, I32 flags);
+PERL_CALLCONV OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv);
+PERL_CALLCONV SV* Perl_newRV(pTHX_ SV* pref);
+PERL_CALLCONV SV* Perl_newRV_noinc(pTHX_ SV *sv);
+PERL_CALLCONV SV* Perl_newSV(pTHX_ STRLEN len);
+PERL_CALLCONV OP* Perl_newSVREF(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv);
+PERL_CALLCONV SV* Perl_newSViv(pTHX_ IV i);
+PERL_CALLCONV SV* Perl_newSVnv(pTHX_ NV n);
+PERL_CALLCONV SV* Perl_newSVpv(pTHX_ const char* s, STRLEN len);
+PERL_CALLCONV SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len);
+PERL_CALLCONV SV* Perl_newSVpvf(pTHX_ const char* pat, ...);
+PERL_CALLCONV SV* Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV SV* Perl_newSVrv(pTHX_ SV* rv, const char* classname);
+PERL_CALLCONV SV* Perl_newSVsv(pTHX_ SV* old);
+PERL_CALLCONV OP* Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first);
+PERL_CALLCONV OP* Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont);
+
+PERL_CALLCONV PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems);
+PERL_CALLCONV PerlIO* Perl_nextargv(pTHX_ GV* gv);
+PERL_CALLCONV char* Perl_ninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend);
+PERL_CALLCONV OP* Perl_oopsCV(pTHX_ OP* o);
+PERL_CALLCONV void Perl_op_free(pTHX_ OP* arg);
+PERL_CALLCONV void Perl_package(pTHX_ OP* o);
+PERL_CALLCONV PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype);
+PERL_CALLCONV PADOFFSET Perl_pad_allocmy(pTHX_ char* name);
+PERL_CALLCONV PADOFFSET Perl_pad_findmy(pTHX_ char* name);
+PERL_CALLCONV OP* Perl_oopsAV(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_oopsHV(pTHX_ OP* o);
+PERL_CALLCONV void Perl_pad_leavemy(pTHX_ I32 fill);
+PERL_CALLCONV SV* Perl_pad_sv(pTHX_ PADOFFSET po);
+PERL_CALLCONV void Perl_pad_free(pTHX_ PADOFFSET po);
+PERL_CALLCONV void Perl_pad_reset(pTHX);
+PERL_CALLCONV void Perl_pad_swipe(pTHX_ PADOFFSET po);
+PERL_CALLCONV void Perl_peep(pTHX_ OP* o);
#if defined(PERL_OBJECT)
-VIRTUAL void perl_construct(void);
-VIRTUAL void perl_destruct(void);
-VIRTUAL void perl_free(void);
-VIRTUAL int perl_run(void);
-VIRTUAL int perl_parse(XSINIT_t xsinit, int argc, char** argv, char** env);
-#else
-VIRTUAL PerlInterpreter* perl_alloc(void);
-VIRTUAL void perl_construct(PerlInterpreter* sv_interp);
-VIRTUAL void perl_destruct(PerlInterpreter* sv_interp);
-VIRTUAL void perl_free(PerlInterpreter* sv_interp);
-VIRTUAL int perl_run(PerlInterpreter* sv_interp);
-VIRTUAL int perl_parse(PerlInterpreter* sv_interp, XSINIT_t xsinit, int argc, char** argv, char** env);
-#if defined(USE_THREADS)
-VIRTUAL struct perl_thread* Perl_new_struct_thread(pTHX_ struct perl_thread *t);
+PERL_CALLCONV void Perl_construct(pTHX);
+PERL_CALLCONV void Perl_destruct(pTHX);
+PERL_CALLCONV void Perl_free(pTHX);
+PERL_CALLCONV int Perl_run(pTHX);
+PERL_CALLCONV int Perl_parse(pTHX_ XSINIT_t xsinit, int argc, char** argv, char** env);
#endif
+#if defined(USE_THREADS)
+PERL_CALLCONV struct perl_thread* Perl_new_struct_thread(pTHX_ struct perl_thread *t);
#endif
-VIRTUAL void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr);
-VIRTUAL I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** argv);
-VIRTUAL I32 Perl_call_method(pTHX_ const char* methname, I32 flags);
-VIRTUAL I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags);
-VIRTUAL I32 Perl_call_sv(pTHX_ SV* sv, I32 flags);
-VIRTUAL SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error);
-VIRTUAL I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags);
-VIRTUAL SV* Perl_get_sv(pTHX_ const char* name, I32 create);
-VIRTUAL AV* Perl_get_av(pTHX_ const char* name, I32 create);
-VIRTUAL HV* Perl_get_hv(pTHX_ const char* name, I32 create);
-VIRTUAL CV* Perl_get_cv(pTHX_ const char* name, I32 create);
-VIRTUAL int Perl_init_i18nl10n(pTHX_ int printwarn);
-VIRTUAL int Perl_init_i18nl14n(pTHX_ int printwarn);
-VIRTUAL void Perl_new_collate(pTHX_ const char* newcoll);
-VIRTUAL void Perl_new_ctype(pTHX_ const char* newctype);
-VIRTUAL void Perl_new_numeric(pTHX_ const char* newcoll);
-VIRTUAL void Perl_set_numeric_local(pTHX);
-VIRTUAL void Perl_set_numeric_radix(pTHX);
-VIRTUAL void Perl_set_numeric_standard(pTHX);
-VIRTUAL void Perl_require_pv(pTHX_ const char* pv);
-VIRTUAL void Perl_pidgone(pTHX_ Pid_t pid, int status);
-VIRTUAL void Perl_pmflag(pTHX_ U16* pmfl, int ch);
-VIRTUAL OP* Perl_pmruntime(pTHX_ OP* pm, OP* expr, OP* repl);
-VIRTUAL OP* Perl_pmtrans(pTHX_ OP* o, OP* expr, OP* repl);
-VIRTUAL OP* Perl_pop_return(pTHX);
-VIRTUAL void Perl_pop_scope(pTHX);
-VIRTUAL OP* Perl_prepend_elem(pTHX_ I32 optype, OP* head, OP* tail);
-VIRTUAL void Perl_push_return(pTHX_ OP* o);
-VIRTUAL void Perl_push_scope(pTHX);
-VIRTUAL OP* Perl_ref(pTHX_ OP* o, I32 type);
-VIRTUAL OP* Perl_refkids(pTHX_ OP* o, I32 type);
-VIRTUAL void Perl_regdump(pTHX_ regexp* r);
-VIRTUAL I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave);
-VIRTUAL void Perl_pregfree(pTHX_ struct regexp* r);
-VIRTUAL regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm);
-VIRTUAL char* Perl_re_intuit_start(pTHX_ regexp* prog, SV* sv, char* strpos, char* strend, U32 flags, struct re_scream_pos_data_s *data);
-VIRTUAL SV* Perl_re_intuit_string(pTHX_ regexp* prog);
-VIRTUAL I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags);
-VIRTUAL regnode* Perl_regnext(pTHX_ regnode* p);
-VIRTUAL void Perl_regprop(pTHX_ SV* sv, regnode* o);
-VIRTUAL void Perl_repeatcpy(pTHX_ char* to, const char* from, I32 len, I32 count);
-VIRTUAL char* Perl_rninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend);
-VIRTUAL Sighandler_t Perl_rsignal(pTHX_ int i, Sighandler_t t);
-VIRTUAL int Perl_rsignal_restore(pTHX_ int i, Sigsave_t* t);
-VIRTUAL int Perl_rsignal_save(pTHX_ int i, Sighandler_t t1, Sigsave_t* t2);
-VIRTUAL Sighandler_t Perl_rsignal_state(pTHX_ int i);
-VIRTUAL void Perl_rxres_free(pTHX_ void** rsp);
-VIRTUAL void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx);
-VIRTUAL void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx);
+PERL_CALLCONV void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr);
+PERL_CALLCONV I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** argv);
+PERL_CALLCONV I32 Perl_call_method(pTHX_ const char* methname, I32 flags);
+PERL_CALLCONV I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags);
+PERL_CALLCONV I32 Perl_call_sv(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error);
+PERL_CALLCONV I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char* name, I32 create);
+PERL_CALLCONV AV* Perl_get_av(pTHX_ const char* name, I32 create);
+PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char* name, I32 create);
+PERL_CALLCONV CV* Perl_get_cv(pTHX_ const char* name, I32 create);
+PERL_CALLCONV int Perl_init_i18nl10n(pTHX_ int printwarn);
+PERL_CALLCONV int Perl_init_i18nl14n(pTHX_ int printwarn);
+PERL_CALLCONV void Perl_new_collate(pTHX_ const char* newcoll);
+PERL_CALLCONV void Perl_new_ctype(pTHX_ const char* newctype);
+PERL_CALLCONV void Perl_new_numeric(pTHX_ const char* newcoll);
+PERL_CALLCONV void Perl_set_numeric_local(pTHX);
+PERL_CALLCONV void Perl_set_numeric_radix(pTHX);
+PERL_CALLCONV void Perl_set_numeric_standard(pTHX);
+PERL_CALLCONV void Perl_require_pv(pTHX_ const char* pv);
+PERL_CALLCONV void Perl_pidgone(pTHX_ Pid_t pid, int status);
+PERL_CALLCONV void Perl_pmflag(pTHX_ U16* pmfl, int ch);
+PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP* pm, OP* expr, OP* repl);
+PERL_CALLCONV OP* Perl_pmtrans(pTHX_ OP* o, OP* expr, OP* repl);
+PERL_CALLCONV OP* Perl_pop_return(pTHX);
+PERL_CALLCONV void Perl_pop_scope(pTHX);
+PERL_CALLCONV OP* Perl_prepend_elem(pTHX_ I32 optype, OP* head, OP* tail);
+PERL_CALLCONV void Perl_push_return(pTHX_ OP* o);
+PERL_CALLCONV void Perl_push_scope(pTHX);
+PERL_CALLCONV OP* Perl_ref(pTHX_ OP* o, I32 type);
+PERL_CALLCONV OP* Perl_refkids(pTHX_ OP* o, I32 type);
+PERL_CALLCONV void Perl_regdump(pTHX_ regexp* r);
+PERL_CALLCONV I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave);
+PERL_CALLCONV void Perl_pregfree(pTHX_ struct regexp* r);
+PERL_CALLCONV regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm);
+PERL_CALLCONV char* Perl_re_intuit_start(pTHX_ regexp* prog, SV* sv, char* strpos, char* strend, U32 flags, struct re_scream_pos_data_s *data);
+PERL_CALLCONV SV* Perl_re_intuit_string(pTHX_ regexp* prog);
+PERL_CALLCONV I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags);
+PERL_CALLCONV regnode* Perl_regnext(pTHX_ regnode* p);
+PERL_CALLCONV void Perl_regprop(pTHX_ SV* sv, regnode* o);
+PERL_CALLCONV void Perl_repeatcpy(pTHX_ char* to, const char* from, I32 len, I32 count);
+PERL_CALLCONV char* Perl_rninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend);
+PERL_CALLCONV Sighandler_t Perl_rsignal(pTHX_ int i, Sighandler_t t);
+PERL_CALLCONV int Perl_rsignal_restore(pTHX_ int i, Sigsave_t* t);
+PERL_CALLCONV int Perl_rsignal_save(pTHX_ int i, Sighandler_t t1, Sigsave_t* t2);
+PERL_CALLCONV Sighandler_t Perl_rsignal_state(pTHX_ int i);
+PERL_CALLCONV void Perl_rxres_free(pTHX_ void** rsp);
+PERL_CALLCONV void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx);
+PERL_CALLCONV void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx);
#if !defined(HAS_RENAME)
-VIRTUAL I32 Perl_same_dirent(pTHX_ char* a, char* b);
+PERL_CALLCONV I32 Perl_same_dirent(pTHX_ char* a, char* b);
#endif
-VIRTUAL char* Perl_savepv(pTHX_ const char* sv);
-VIRTUAL char* Perl_savepvn(pTHX_ const char* sv, I32 len);
-VIRTUAL void Perl_savestack_grow(pTHX);
-VIRTUAL void Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr);
-VIRTUAL I32 Perl_save_alloc(pTHX_ I32 size, I32 pad);
-VIRTUAL void Perl_save_aptr(pTHX_ AV** aptr);
-VIRTUAL AV* Perl_save_ary(pTHX_ GV* gv);
-VIRTUAL void Perl_save_clearsv(pTHX_ SV** svp);
-VIRTUAL void Perl_save_delete(pTHX_ HV* hv, char* key, I32 klen);
-VIRTUAL void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p);
-VIRTUAL void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p);
-VIRTUAL void Perl_save_freesv(pTHX_ SV* sv);
-VIRTUAL void Perl_save_freeop(pTHX_ OP* o);
-VIRTUAL void Perl_save_freepv(pTHX_ char* pv);
-VIRTUAL void Perl_save_generic_svref(pTHX_ SV** sptr);
-VIRTUAL void Perl_save_gp(pTHX_ GV* gv, I32 empty);
-VIRTUAL HV* Perl_save_hash(pTHX_ GV* gv);
-VIRTUAL void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr);
-VIRTUAL void Perl_save_hints(pTHX);
-VIRTUAL void Perl_save_hptr(pTHX_ HV** hptr);
-VIRTUAL void Perl_save_I16(pTHX_ I16* intp);
-VIRTUAL void Perl_save_I32(pTHX_ I32* intp);
-VIRTUAL void Perl_save_int(pTHX_ int* intp);
-VIRTUAL void Perl_save_item(pTHX_ SV* item);
-VIRTUAL void Perl_save_iv(pTHX_ IV* iv);
-VIRTUAL void Perl_save_list(pTHX_ SV** sarg, I32 maxsarg);
-VIRTUAL void Perl_save_long(pTHX_ long* longp);
-VIRTUAL void Perl_save_nogv(pTHX_ GV* gv);
-VIRTUAL void Perl_save_op(pTHX);
-VIRTUAL SV* Perl_save_scalar(pTHX_ GV* gv);
-VIRTUAL void Perl_save_pptr(pTHX_ char** pptr);
-VIRTUAL void Perl_save_re_context(pTHX);
-VIRTUAL void Perl_save_sptr(pTHX_ SV** sptr);
-VIRTUAL SV* Perl_save_svref(pTHX_ SV** sptr);
-VIRTUAL SV** Perl_save_threadsv(pTHX_ PADOFFSET i);
-VIRTUAL OP* Perl_sawparens(pTHX_ OP* o);
-VIRTUAL OP* Perl_scalar(pTHX_ OP* o);
-VIRTUAL OP* Perl_scalarkids(pTHX_ OP* o);
-VIRTUAL OP* Perl_scalarseq(pTHX_ OP* o);
-VIRTUAL OP* Perl_scalarvoid(pTHX_ OP* o);
-VIRTUAL NV Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen);
-VIRTUAL NV Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen);
-VIRTUAL char* Perl_scan_num(pTHX_ char* s);
-VIRTUAL NV Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen);
-VIRTUAL OP* Perl_scope(pTHX_ OP* o);
-VIRTUAL char* Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last);
+PERL_CALLCONV char* Perl_savepv(pTHX_ const char* sv);
+PERL_CALLCONV char* Perl_savepvn(pTHX_ const char* sv, I32 len);
+PERL_CALLCONV void Perl_savestack_grow(pTHX);
+PERL_CALLCONV void Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr);
+PERL_CALLCONV I32 Perl_save_alloc(pTHX_ I32 size, I32 pad);
+PERL_CALLCONV void Perl_save_aptr(pTHX_ AV** aptr);
+PERL_CALLCONV AV* Perl_save_ary(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_save_clearsv(pTHX_ SV** svp);
+PERL_CALLCONV void Perl_save_delete(pTHX_ HV* hv, char* key, I32 klen);
+PERL_CALLCONV void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p);
+PERL_CALLCONV void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p);
+PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o);
+PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv);
+PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr);
+PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty);
+PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr);
+PERL_CALLCONV void Perl_save_hints(pTHX);
+PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr);
+PERL_CALLCONV void Perl_save_I16(pTHX_ I16* intp);
+PERL_CALLCONV void Perl_save_I32(pTHX_ I32* intp);
+PERL_CALLCONV void Perl_save_I8(pTHX_ I8* bytep);
+PERL_CALLCONV void Perl_save_int(pTHX_ int* intp);
+PERL_CALLCONV void Perl_save_item(pTHX_ SV* item);
+PERL_CALLCONV void Perl_save_iv(pTHX_ IV* iv);
+PERL_CALLCONV void Perl_save_list(pTHX_ SV** sarg, I32 maxsarg);
+PERL_CALLCONV void Perl_save_long(pTHX_ long* longp);
+PERL_CALLCONV void Perl_save_nogv(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_save_op(pTHX);
+PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv);
+PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr);
+PERL_CALLCONV void Perl_save_vptr(pTHX_ void* pptr);
+PERL_CALLCONV void Perl_save_re_context(pTHX);
+PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr);
+PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr);
+PERL_CALLCONV SV** Perl_save_threadsv(pTHX_ PADOFFSET i);
+PERL_CALLCONV OP* Perl_sawparens(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_scalar(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_scalarkids(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_scalarseq(pTHX_ OP* o);
+PERL_CALLCONV OP* Perl_scalarvoid(pTHX_ OP* o);
+PERL_CALLCONV NV Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen);
+PERL_CALLCONV NV Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen);
+PERL_CALLCONV char* Perl_scan_num(pTHX_ char* s);
+PERL_CALLCONV NV Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen);
+PERL_CALLCONV OP* Perl_scope(pTHX_ OP* o);
+PERL_CALLCONV char* Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last);
#if !defined(VMS)
-VIRTUAL I32 Perl_setenv_getix(pTHX_ char* nam);
+PERL_CALLCONV I32 Perl_setenv_getix(pTHX_ char* nam);
#endif
-VIRTUAL void Perl_setdefout(pTHX_ GV* gv);
-VIRTUAL char* Perl_sharepvn(pTHX_ const char* sv, I32 len, U32 hash);
-VIRTUAL HEK* Perl_share_hek(pTHX_ const char* sv, I32 len, U32 hash);
-VIRTUAL Signal_t Perl_sighandler(int sig);
-VIRTUAL SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n);
-VIRTUAL I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags);
-VIRTUAL void Perl_sub_crush_depth(pTHX_ CV* cv);
-VIRTUAL bool Perl_sv_2bool(pTHX_ SV* sv);
-VIRTUAL CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
-VIRTUAL IO* Perl_sv_2io(pTHX_ SV* sv);
-VIRTUAL IV Perl_sv_2iv(pTHX_ SV* sv);
-VIRTUAL SV* Perl_sv_2mortal(pTHX_ SV* sv);
-VIRTUAL NV Perl_sv_2nv(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL UV Perl_sv_2uv(pTHX_ SV* sv);
-VIRTUAL IV Perl_sv_iv(pTHX_ SV* sv);
-VIRTUAL UV Perl_sv_uv(pTHX_ SV* sv);
-VIRTUAL NV Perl_sv_nv(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len);
-VIRTUAL char* Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *len);
-VIRTUAL char* Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *len);
-VIRTUAL I32 Perl_sv_true(pTHX_ SV *sv);
-VIRTUAL void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags);
-VIRTUAL int Perl_sv_backoff(pTHX_ SV* sv);
-VIRTUAL SV* Perl_sv_bless(pTHX_ SV* sv, HV* stash);
-VIRTUAL void Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...);
-VIRTUAL void Perl_sv_vcatpvf(pTHX_ SV* sv, const char* pat, va_list* args);
-VIRTUAL void Perl_sv_catpv(pTHX_ SV* sv, const char* ptr);
-VIRTUAL void Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
-VIRTUAL void Perl_sv_catsv(pTHX_ SV* dsv, SV* ssv);
-VIRTUAL void Perl_sv_chop(pTHX_ SV* sv, char* ptr);
-VIRTUAL void Perl_sv_clean_all(pTHX);
-VIRTUAL void Perl_sv_clean_objs(pTHX);
-VIRTUAL void Perl_sv_clear(pTHX_ SV* sv);
-VIRTUAL I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2);
-VIRTUAL I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
+PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv);
+PERL_CALLCONV char* Perl_sharepvn(pTHX_ const char* sv, I32 len, U32 hash);
+PERL_CALLCONV HEK* Perl_share_hek(pTHX_ const char* sv, I32 len, U32 hash);
+PERL_CALLCONV Signal_t Perl_sighandler(int sig);
+PERL_CALLCONV SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n);
+PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags);
+PERL_CALLCONV void Perl_sub_crush_depth(pTHX_ CV* cv);
+PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv);
+PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
+PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv);
+PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv);
+PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
+PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv);
+PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv);
+PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv);
+PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len);
+PERL_CALLCONV char* Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *len);
+PERL_CALLCONV char* Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *len);
+PERL_CALLCONV I32 Perl_sv_true(pTHX_ SV *sv);
+PERL_CALLCONV void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags);
+PERL_CALLCONV int Perl_sv_backoff(pTHX_ SV* sv);
+PERL_CALLCONV SV* Perl_sv_bless(pTHX_ SV* sv, HV* stash);
+PERL_CALLCONV void Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_vcatpvf(pTHX_ SV* sv, const char* pat, va_list* args);
+PERL_CALLCONV void Perl_sv_catpv(pTHX_ SV* sv, const char* ptr);
+PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
+PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV* dsv, SV* ssv);
+PERL_CALLCONV void Perl_sv_chop(pTHX_ SV* sv, char* ptr);
+PERL_CALLCONV void Perl_sv_clean_all(pTHX);
+PERL_CALLCONV void Perl_sv_clean_objs(pTHX);
+PERL_CALLCONV void Perl_sv_clear(pTHX_ SV* sv);
+PERL_CALLCONV I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2);
+PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
#if defined(USE_LOCALE_COLLATE)
-VIRTUAL char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp);
+PERL_CALLCONV char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp);
#endif
-VIRTUAL OP* Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp);
-VIRTUAL void Perl_sv_dec(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_dump(pTHX_ SV* sv);
-VIRTUAL bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name);
-VIRTUAL I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2);
-VIRTUAL void Perl_sv_free(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_free_arenas(pTHX);
-VIRTUAL char* Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append);
-VIRTUAL char* Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen);
-VIRTUAL void Perl_sv_inc(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_insert(pTHX_ SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen);
-VIRTUAL int Perl_sv_isa(pTHX_ SV* sv, const char* name);
-VIRTUAL int Perl_sv_isobject(pTHX_ SV* sv);
-VIRTUAL STRLEN Perl_sv_len(pTHX_ SV* sv);
-VIRTUAL STRLEN Perl_sv_len_utf8(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_magic(pTHX_ SV* sv, SV* obj, int how, const char* name, I32 namlen);
-VIRTUAL SV* Perl_sv_mortalcopy(pTHX_ SV* oldsv);
-VIRTUAL SV* Perl_sv_newmortal(pTHX);
-VIRTUAL SV* Perl_sv_newref(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_peek(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp);
-VIRTUAL void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
-VIRTUAL char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp);
-VIRTUAL char* Perl_sv_reftype(pTHX_ SV* sv, int ob);
-VIRTUAL void Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
-VIRTUAL void Perl_sv_report_used(pTHX);
-VIRTUAL void Perl_sv_reset(pTHX_ char* s, HV* stash);
-VIRTUAL void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...);
-VIRTUAL void Perl_sv_vsetpvf(pTHX_ SV* sv, const char* pat, va_list* args);
-VIRTUAL void Perl_sv_setiv(pTHX_ SV* sv, IV num);
-VIRTUAL void Perl_sv_setpviv(pTHX_ SV* sv, IV num);
-VIRTUAL void Perl_sv_setuv(pTHX_ SV* sv, UV num);
-VIRTUAL void Perl_sv_setnv(pTHX_ SV* sv, NV num);
-VIRTUAL SV* Perl_sv_setref_iv(pTHX_ SV* rv, const char* classname, IV iv);
-VIRTUAL SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, NV nv);
-VIRTUAL SV* Perl_sv_setref_pv(pTHX_ SV* rv, const char* classname, void* pv);
-VIRTUAL SV* Perl_sv_setref_pvn(pTHX_ SV* rv, const char* classname, char* pv, STRLEN n);
-VIRTUAL void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr);
-VIRTUAL void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
-VIRTUAL void Perl_sv_setsv(pTHX_ SV* dsv, SV* ssv);
-VIRTUAL void Perl_sv_taint(pTHX_ SV* sv);
-VIRTUAL bool Perl_sv_tainted(pTHX_ SV* sv);
-VIRTUAL int Perl_sv_unmagic(pTHX_ SV* sv, int type);
-VIRTUAL void Perl_sv_unref(pTHX_ SV* sv);
-VIRTUAL void Perl_sv_untaint(pTHX_ SV* sv);
-VIRTUAL bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
-VIRTUAL void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
-VIRTUAL void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
-VIRTUAL void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
-VIRTUAL SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none);
-VIRTUAL UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr);
-VIRTUAL void Perl_taint_env(pTHX);
-VIRTUAL void Perl_taint_proper(pTHX_ const char* f, char* s);
-VIRTUAL UV Perl_to_utf8_lower(pTHX_ U8 *p);
-VIRTUAL UV Perl_to_utf8_upper(pTHX_ U8 *p);
-VIRTUAL UV Perl_to_utf8_title(pTHX_ U8 *p);
+PERL_CALLCONV OP* Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp);
+PERL_CALLCONV void Perl_sv_dec(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_dump(pTHX_ SV* sv);
+PERL_CALLCONV bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name);
+PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2);
+PERL_CALLCONV void Perl_sv_free(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_free_arenas(pTHX);
+PERL_CALLCONV char* Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append);
+PERL_CALLCONV char* Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen);
+PERL_CALLCONV void Perl_sv_inc(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_insert(pTHX_ SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen);
+PERL_CALLCONV int Perl_sv_isa(pTHX_ SV* sv, const char* name);
+PERL_CALLCONV int Perl_sv_isobject(pTHX_ SV* sv);
+PERL_CALLCONV STRLEN Perl_sv_len(pTHX_ SV* sv);
+PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_magic(pTHX_ SV* sv, SV* obj, int how, const char* name, I32 namlen);
+PERL_CALLCONV SV* Perl_sv_mortalcopy(pTHX_ SV* oldsv);
+PERL_CALLCONV SV* Perl_sv_newmortal(pTHX);
+PERL_CALLCONV SV* Perl_sv_newref(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_peek(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp);
+PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
+PERL_CALLCONV char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_reftype(pTHX_ SV* sv, int ob);
+PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
+PERL_CALLCONV void Perl_sv_report_used(pTHX);
+PERL_CALLCONV void Perl_sv_reset(pTHX_ char* s, HV* stash);
+PERL_CALLCONV void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_vsetpvf(pTHX_ SV* sv, const char* pat, va_list* args);
+PERL_CALLCONV void Perl_sv_setiv(pTHX_ SV* sv, IV num);
+PERL_CALLCONV void Perl_sv_setpviv(pTHX_ SV* sv, IV num);
+PERL_CALLCONV void Perl_sv_setuv(pTHX_ SV* sv, UV num);
+PERL_CALLCONV void Perl_sv_setnv(pTHX_ SV* sv, NV num);
+PERL_CALLCONV SV* Perl_sv_setref_iv(pTHX_ SV* rv, const char* classname, IV iv);
+PERL_CALLCONV SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, NV nv);
+PERL_CALLCONV SV* Perl_sv_setref_pv(pTHX_ SV* rv, const char* classname, void* pv);
+PERL_CALLCONV SV* Perl_sv_setref_pvn(pTHX_ SV* rv, const char* classname, char* pv, STRLEN n);
+PERL_CALLCONV void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr);
+PERL_CALLCONV void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
+PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV* dsv, SV* ssv);
+PERL_CALLCONV void Perl_sv_taint(pTHX_ SV* sv);
+PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv);
+PERL_CALLCONV int Perl_sv_unmagic(pTHX_ SV* sv, int type);
+PERL_CALLCONV void Perl_sv_unref(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv);
+PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
+PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
+PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
+PERL_CALLCONV void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
+PERL_CALLCONV SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none);
+PERL_CALLCONV UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr);
+PERL_CALLCONV void Perl_taint_env(pTHX);
+PERL_CALLCONV void Perl_taint_proper(pTHX_ const char* f, const char* s);
+PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ U8 *p);
+PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ U8 *p);
+PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ U8 *p);
+PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp);
+PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
+PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp);
#if defined(UNLINK_ALL_VERSIONS)
-VIRTUAL I32 Perl_unlnk(pTHX_ char* f);
+PERL_CALLCONV I32 Perl_unlnk(pTHX_ char* f);
#endif
#if defined(USE_THREADS)
-VIRTUAL void Perl_unlock_condpair(pTHX_ void* svv);
+PERL_CALLCONV void Perl_unlock_condpair(pTHX_ void* svv);
#endif
-VIRTUAL void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash);
-VIRTUAL void Perl_unshare_hek(pTHX_ HEK* hek);
-VIRTUAL void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* id, OP* arg);
-VIRTUAL U8* Perl_utf16_to_utf8(pTHX_ U16* p, U8 *d, I32 bytelen);
-VIRTUAL U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen);
-VIRTUAL I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b);
-VIRTUAL U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off);
-VIRTUAL UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen);
-VIRTUAL U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv);
-VIRTUAL void Perl_vivify_defelem(pTHX_ SV* sv);
-VIRTUAL void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what);
-VIRTUAL I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags);
-VIRTUAL void Perl_warn(pTHX_ const char* pat, ...);
-VIRTUAL void Perl_vwarn(pTHX_ const char* pat, va_list* args);
-VIRTUAL void Perl_warner(pTHX_ U32 err, const char* pat, ...);
-VIRTUAL void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args);
-VIRTUAL void Perl_watch(pTHX_ char** addr);
-VIRTUAL I32 Perl_whichsig(pTHX_ char* sig);
-VIRTUAL int Perl_yyerror(pTHX_ char* s);
+PERL_CALLCONV void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash);
+PERL_CALLCONV void Perl_unshare_hek(pTHX_ HEK* hek);
+PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* id, OP* arg);
+PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U16* p, U8 *d, I32 bytelen);
+PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen);
+PERL_CALLCONV I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b);
+PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off);
+PERL_CALLCONV UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen);
+PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv);
+PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what);
+PERL_CALLCONV I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags);
+PERL_CALLCONV void Perl_report_uninit(pTHX);
+PERL_CALLCONV void Perl_warn(pTHX_ const char* pat, ...);
+PERL_CALLCONV void Perl_vwarn(pTHX_ const char* pat, va_list* args);
+PERL_CALLCONV void Perl_warner(pTHX_ U32 err, const char* pat, ...);
+PERL_CALLCONV void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args);
+PERL_CALLCONV void Perl_watch(pTHX_ char** addr);
+PERL_CALLCONV I32 Perl_whichsig(pTHX_ char* sig);
+PERL_CALLCONV int Perl_yyerror(pTHX_ char* s);
#if defined(USE_PURE_BISON)
-VIRTUAL int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
+PERL_CALLCONV int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
#else
-VIRTUAL int Perl_yylex(pTHX);
+PERL_CALLCONV int Perl_yylex(pTHX);
#endif
-VIRTUAL int Perl_yyparse(pTHX);
-VIRTUAL int Perl_yywarn(pTHX_ char* s);
+PERL_CALLCONV int Perl_yyparse(pTHX);
+PERL_CALLCONV int Perl_yywarn(pTHX_ char* s);
#if defined(MYMALLOC)
-VIRTUAL void Perl_dump_mstats(pTHX_ char* s);
-VIRTUAL Malloc_t Perl_malloc(MEM_SIZE nbytes);
-VIRTUAL Malloc_t Perl_calloc(MEM_SIZE elements, MEM_SIZE size);
-VIRTUAL Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes);
-VIRTUAL Free_t Perl_mfree(Malloc_t where);
+PERL_CALLCONV void Perl_dump_mstats(pTHX_ char* s);
#endif
-VIRTUAL Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes);
-VIRTUAL Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size);
-VIRTUAL Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes);
-VIRTUAL Free_t Perl_safesysfree(Malloc_t where);
+PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes);
+PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size);
+PERL_CALLCONV Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes);
+PERL_CALLCONV Free_t Perl_safesysfree(Malloc_t where);
#if defined(LEAKTEST)
-VIRTUAL Malloc_t Perl_safexmalloc(I32 x, MEM_SIZE size);
-VIRTUAL Malloc_t Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size);
-VIRTUAL Malloc_t Perl_safexrealloc(Malloc_t where, MEM_SIZE size);
-VIRTUAL void Perl_safexfree(Malloc_t where);
+PERL_CALLCONV Malloc_t Perl_safexmalloc(I32 x, MEM_SIZE size);
+PERL_CALLCONV Malloc_t Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size);
+PERL_CALLCONV Malloc_t Perl_safexrealloc(Malloc_t where, MEM_SIZE size);
+PERL_CALLCONV void Perl_safexfree(Malloc_t where);
#endif
#if defined(PERL_GLOBAL_STRUCT)
-VIRTUAL struct perl_vars * Perl_GetVars(pTHX);
+PERL_CALLCONV struct perl_vars * Perl_GetVars(pTHX);
+#endif
+PERL_CALLCONV int Perl_runops_standard(pTHX);
+PERL_CALLCONV int Perl_runops_debug(pTHX);
+PERL_CALLCONV void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_vcatpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
+PERL_CALLCONV void Perl_sv_catpv_mg(pTHX_ SV *sv, const char *ptr);
+PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
+PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dstr, SV *sstr);
+PERL_CALLCONV void Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...);
+PERL_CALLCONV void Perl_sv_vsetpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
+PERL_CALLCONV void Perl_sv_setiv_mg(pTHX_ SV *sv, IV i);
+PERL_CALLCONV void Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv);
+PERL_CALLCONV void Perl_sv_setuv_mg(pTHX_ SV *sv, UV u);
+PERL_CALLCONV void Perl_sv_setnv_mg(pTHX_ SV *sv, NV num);
+PERL_CALLCONV void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr);
+PERL_CALLCONV void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
+PERL_CALLCONV void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
+PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
+PERL_CALLCONV MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id);
+PERL_CALLCONV char* Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+PERL_CALLCONV void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...);
+PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args);
+PERL_CALLCONV void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);
+PERL_CALLCONV void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);
+PERL_CALLCONV void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv);
+PERL_CALLCONV void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
+PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o);
+PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm);
+PERL_CALLCONV void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
+PERL_CALLCONV void Perl_magic_dump(pTHX_ MAGIC *mg);
+PERL_CALLCONV void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...);
+PERL_CALLCONV void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args);
+PERL_CALLCONV void Perl_reginitcolors(pTHX);
+PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_pv(pTHX_ SV *sv);
+PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);
+PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n);
+PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *sv);
+PERL_CALLCONV int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg);
+PERL_CALLCONV OP* Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block);
+PERL_CALLCONV CV* Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
+PERL_CALLCONV void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
+PERL_CALLCONV OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs);
+PERL_CALLCONV void Perl_boot_core_xsutils(pTHX);
+#if defined(USE_ITHREADS)
+PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max);
+PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si);
+PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl);
+PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl);
+PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared);
+PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r);
+PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type);
+PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp);
+PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp);
+PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg);
+PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr);
+#if defined(HAVE_INTERP_INTERN)
+PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst);
+#endif
+PERL_CALLCONV PTR_TBL_t* Perl_ptr_table_new(pTHX);
+PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv);
+PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv);
+PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
#endif
-VIRTUAL int Perl_runops_standard(pTHX);
-VIRTUAL int Perl_runops_debug(pTHX);
-VIRTUAL void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...);
-VIRTUAL void Perl_sv_vcatpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
-VIRTUAL void Perl_sv_catpv_mg(pTHX_ SV *sv, const char *ptr);
-VIRTUAL void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
-VIRTUAL void Perl_sv_catsv_mg(pTHX_ SV *dstr, SV *sstr);
-VIRTUAL void Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...);
-VIRTUAL void Perl_sv_vsetpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
-VIRTUAL void Perl_sv_setiv_mg(pTHX_ SV *sv, IV i);
-VIRTUAL void Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv);
-VIRTUAL void Perl_sv_setuv_mg(pTHX_ SV *sv, UV u);
-VIRTUAL void Perl_sv_setnv_mg(pTHX_ SV *sv, NV num);
-VIRTUAL void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr);
-VIRTUAL void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
-VIRTUAL void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
-VIRTUAL void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
-VIRTUAL MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id);
-VIRTUAL char* Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-VIRTUAL void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...);
-VIRTUAL void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args);
-VIRTUAL void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);
-VIRTUAL void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);
-VIRTUAL void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv);
-VIRTUAL void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
-VIRTUAL void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o);
-VIRTUAL void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm);
-VIRTUAL void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
-VIRTUAL void Perl_magic_dump(pTHX_ MAGIC *mg);
-VIRTUAL void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...);
-VIRTUAL void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args);
-VIRTUAL void Perl_reginitcolors(pTHX);
-VIRTUAL char* Perl_sv_2pv_nolen(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv);
-VIRTUAL char* Perl_sv_pv(pTHX_ SV *sv);
-VIRTUAL char* Perl_sv_pvutf8(pTHX_ SV *sv);
-VIRTUAL char* Perl_sv_pvbyte(pTHX_ SV *sv);
-VIRTUAL void Perl_sv_force_normal(pTHX_ SV *sv);
-VIRTUAL void Perl_tmps_grow(pTHX_ I32 n);
-VIRTUAL SV* Perl_sv_rvweaken(pTHX_ SV *sv);
-VIRTUAL int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg);
-VIRTUAL OP* Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block);
-VIRTUAL CV* Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
-VIRTUAL void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
-VIRTUAL OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs);
-VIRTUAL void Perl_boot_core_xsutils(pTHX);
+
+PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv);
+PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv);
#if defined(PERL_OBJECT)
protected:
+#else
+END_EXTERN_C
#endif
+
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
STATIC I32 S_avhv_index_sv(pTHX_ SV* sv);
#endif
+
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
STATIC I32 S_do_trans_CC_simple(pTHX_ SV *sv);
STATIC I32 S_do_trans_CC_count(pTHX_ SV *sv);
STATIC I32 S_do_trans_UC_trivial(pTHX_ SV *sv);
STATIC I32 S_do_trans_CU_trivial(pTHX_ SV *sv);
#endif
+
#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
STATIC void S_gv_init_sv(pTHX_ GV *gv, I32 sv_type);
#endif
+
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
STATIC void S_hsplit(pTHX_ HV *hv);
STATIC void S_hfreeentries(pTHX_ HV *hv);
STATIC HEK* S_save_hek(pTHX_ const char *str, I32 len, U32 hash);
STATIC void S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store);
#endif
+
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
STATIC void S_save_magic(pTHX_ I32 mgs_ix, SV *sv);
STATIC int S_magic_methpack(pTHX_ SV *sv, MAGIC *mg, char *meth);
STATIC int S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 f, int n, SV *val);
#endif
+
#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
STATIC I32 S_list_assignment(pTHX_ OP *o);
STATIC void S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid);
STATIC void S_simplify_sort(pTHX_ OP *o);
STATIC bool S_is_handle_constructor(pTHX_ OP *o, I32 argnum);
STATIC char* S_gv_ename(pTHX_ GV *gv);
+STATIC void S_cv_dump(pTHX_ CV *cv);
STATIC CV* S_cv_clone2(pTHX_ CV *proto, CV *outside);
STATIC bool S_scalar_mod_type(pTHX_ OP *o, I32 type);
STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs);
STATIC void* S_Slab_Alloc(pTHX_ int m, size_t sz);
# endif
#endif
+
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
STATIC void S_find_beginning(pTHX);
STATIC void S_forbid_setid(pTHX_ char *);
STATIC struct perl_thread * S_init_main_thread(pTHX);
# endif
#endif
+
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
STATIC void S_doencodes(pTHX_ SV* sv, char* s, I32 len);
STATIC SV* S_refto(pTHX_ SV* sv);
STATIC SV* S_is_an_int(pTHX_ char *s, STRLEN l);
STATIC int S_div128(pTHX_ SV *pnum, bool *done);
#endif
+
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
STATIC OP* S_docatch(pTHX_ OP *o);
STATIC void* S_docatch_body(pTHX_ va_list args);
STATIC PerlIO * S_doopen_pmc(pTHX_ const char *name, const char *mode);
STATIC void S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t f);
#endif
+
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
STATIC CV* S_get_db_sub(pTHX_ SV **svp, CV *cv);
STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp);
#endif
+
#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
STATIC OP* S_doform(pTHX_ CV *cv, GV *gv, OP *retop);
STATIC int S_emulate_eaccess(pTHX_ const char* path, Mode_t mode);
STATIC int S_dooneliner(pTHX_ char *cmd, char *filename);
# endif
#endif
+
#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
STATIC regnode* S_reg(pTHX_ I32, I32 *);
STATIC regnode* S_reganode(pTHX_ U8, U32);
STATIC char* S_regwhite(pTHX_ char *, char *);
STATIC char* S_nextchar(pTHX);
STATIC regnode* S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l);
+STATIC void S_put_byte(pTHX_ SV* sv, int c);
STATIC void S_scan_commit(pTHX_ struct scan_data_t *data);
+STATIC void S_cl_anything(pTHX_ struct regnode_charclass_class *cl);
+STATIC int S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl);
+STATIC void S_cl_init(pTHX_ struct regnode_charclass_class *cl);
+STATIC void S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl);
+STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *and_with);
+STATIC void S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with);
STATIC I32 S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, struct scan_data_t *data, U32 flags);
STATIC I32 S_add_data(pTHX_ I32 n, char *s);
STATIC void S_re_croak2(pTHX_ const char* pat1, const char* pat2, ...) __attribute__((noreturn));
STATIC I32 S_regpposixcc(pTHX_ I32 value);
STATIC void S_checkposixcc(pTHX);
#endif
+
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
STATIC I32 S_regmatch(pTHX_ regnode *prog);
STATIC I32 S_regrepeat(pTHX_ regnode *p, I32 max);
STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp);
STATIC I32 S_regtry(pTHX_ regexp *prog, char *startpos);
-STATIC bool S_reginclass(pTHX_ char *p, I32 c);
+STATIC bool S_reginclass(pTHX_ regnode *p, I32 c);
STATIC bool S_reginclassutf8(pTHX_ regnode *f, U8* p);
STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor);
STATIC char* S_regcppop(pTHX);
STATIC void S_cache_re(pTHX_ regexp *prog);
STATIC U8* S_reghop(pTHX_ U8 *pos, I32 off);
STATIC U8* S_reghopmaybe(pTHX_ U8 *pos, I32 off);
+STATIC char* S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun);
#endif
+
#if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT)
STATIC void S_debprof(pTHX_ OP *o);
#endif
+
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
STATIC SV* S_save_scalar_at(pTHX_ SV **sptr);
#endif
+
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
STATIC IV S_asIV(pTHX_ SV* sv);
STATIC UV S_asUV(pTHX_ SV* sv);
STATIC void S_del_sv(pTHX_ SV *p);
# endif
#endif
+
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
STATIC void S_check_uni(pTHX);
STATIC void S_force_next(pTHX_ I32 type);
STATIC void S_incline(pTHX_ char *s);
STATIC int S_intuit_method(pTHX_ char *s, GV *gv);
STATIC int S_intuit_more(pTHX_ char *s);
-STATIC I32 S_lop(pTHX_ I32 f, expectation x, char *s);
+STATIC I32 S_lop(pTHX_ I32 f, int x, char *s);
STATIC void S_missingterm(pTHX_ char *s);
STATIC void S_no_op(pTHX_ char *what, char *s);
STATIC void S_set_csh(pTHX);
STATIC I32 S_sublex_push(pTHX);
STATIC I32 S_sublex_start(pTHX);
STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append);
-STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type);
+STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type);
STATIC int S_ao(pTHX_ int toketype);
STATIC void S_depcom(pTHX);
STATIC char* S_incl_perldb(pTHX);
STATIC I32 S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen);
# endif
#endif
+
#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level);
#endif
+
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
STATIC SV* S_mess_alloc(pTHX);
# if defined(LEAKTEST)
STATIC void S_xstat(pTHX_ int);
# endif
#endif
+
+#if defined(PERL_OBJECT)
+};
+#endif
I32 offset_float_max;
I32 flags;
I32 whilem_c;
+ struct regnode_charclass_class *start_class;
} scan_data_t;
/*
*/
static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0 };
+ 0, 0, 0, 0, 0 };
#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
#define SF_BEFORE_SEOL 0x1
#define SF_IN_PAR 0x100
#define SF_HAS_EVAL 0x200
#define SCF_DO_SUBSTR 0x400
+#define SCF_DO_STCLASS_AND 0x0800
+#define SCF_DO_STCLASS_OR 0x1000
+#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
#define RF_utf8 8
#define UTF (PL_reg_flags & RF_utf8)
static void clear_re(pTHXo_ void *r);
+/* Mark that we cannot extend a found fixed substring at this point.
+ Updata the longest found anchored substring and the longest found
+ floating substrings if needed. */
+
STATIC void
S_scan_commit(pTHX_ scan_data_t *data)
{
data->flags &= ~SF_BEFORE_EOL;
}
+/* Can match anything (initialization) */
+STATIC void
+S_cl_anything(pTHX_ struct regnode_charclass_class *cl)
+{
+ int value;
+
+ ANYOF_CLASS_ZERO(cl);
+ for (value = 0; value < 256; ++value)
+ ANYOF_BITMAP_SET(cl, value);
+ cl->flags = ANYOF_EOS;
+ if (LOC)
+ cl->flags |= ANYOF_LOCALE;
+}
+
+/* Can match anything (initialization) */
+STATIC int
+S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
+{
+ int value;
+
+ for (value = 0; value < ANYOF_MAX; value += 2)
+ if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
+ return 1;
+ for (value = 0; value < 256; ++value)
+ if (!ANYOF_BITMAP_TEST(cl, value))
+ return 0;
+ return 1;
+}
+
+/* Can match anything (initialization) */
+STATIC void
+S_cl_init(pTHX_ struct regnode_charclass_class *cl)
+{
+ cl->type = ANYOF;
+ cl_anything(cl);
+}
+
+STATIC void
+S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl)
+{
+ cl->type = ANYOF;
+ cl_anything(cl);
+ ANYOF_CLASS_ZERO(cl);
+ ANYOF_BITMAP_ZERO(cl);
+ if (LOC)
+ cl->flags |= ANYOF_LOCALE;
+}
+
+/* 'And' a given class with another one. Can create false positives */
+/* We assume that cl is not inverted */
+STATIC void
+S_cl_and(pTHX_ struct regnode_charclass_class *cl,
+ struct regnode_charclass_class *and_with)
+{
+ int value;
+
+ if (!(and_with->flags & ANYOF_CLASS)
+ && !(cl->flags & ANYOF_CLASS)
+ && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
+ && !(and_with->flags & ANYOF_FOLD)
+ && !(cl->flags & ANYOF_FOLD)) {
+ int i;
+
+ if (and_with->flags & ANYOF_INVERT)
+ for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
+ cl->bitmap[i] &= ~and_with->bitmap[i];
+ else
+ for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
+ cl->bitmap[i] &= and_with->bitmap[i];
+ } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
+ if (!(and_with->flags & ANYOF_EOS))
+ cl->flags &= ~ANYOF_EOS;
+}
+
+/* 'OR' a given class with another one. Can create false positives */
+/* We assume that cl is not inverted */
+STATIC void
+S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with)
+{
+ int value;
+
+ if (or_with->flags & ANYOF_INVERT) {
+ /* We do not use
+ * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
+ * <= (B1 | !B2) | (CL1 | !CL2)
+ * which is wasteful if CL2 is small, but we ignore CL2:
+ * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
+ * XXXX Can we handle case-fold? Unclear:
+ * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
+ * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
+ */
+ if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
+ && !(or_with->flags & ANYOF_FOLD)
+ && !(cl->flags & ANYOF_FOLD) ) {
+ int i;
+
+ for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
+ cl->bitmap[i] |= ~or_with->bitmap[i];
+ } /* XXXX: logic is complicated otherwise */
+ else {
+ cl_anything(cl);
+ }
+ } else {
+ /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
+ if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
+ && (!(or_with->flags & ANYOF_FOLD)
+ || (cl->flags & ANYOF_FOLD)) ) {
+ int i;
+
+ /* OR char bitmap and class bitmap separately */
+ for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
+ cl->bitmap[i] |= or_with->bitmap[i];
+ if (or_with->flags & ANYOF_CLASS) {
+ for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
+ cl->classflags[i] |= or_with->classflags[i];
+ cl->flags |= ANYOF_CLASS;
+ }
+ }
+ else { /* XXXX: logic is complicated, leave it along for a moment. */
+ cl_anything(cl);
+ }
+ }
+ if (or_with->flags & ANYOF_EOS)
+ cl->flags |= ANYOF_EOS;
+}
+
+/* REx optimizer. Converts nodes into quickier variants "in place".
+ Finds fixed substrings. */
+
/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
to the position after last scanned or to NULL. */
int is_inf_internal = 0; /* The studied chunk is infinite */
I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
scan_data_t data_fake;
+ struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
while (scan && OP(scan) != END && scan < last) {
/* Peephole optimizer: */
if (PL_regkind[(U8)OP(scan)] == EXACT) {
+ /* Merge several consecutive EXACTish nodes into one. */
regnode *n = regnext(scan);
U32 stringok = 1;
#ifdef DEBUGGING
/* Allow dumping */
n = scan + NODE_SZ_STR(scan);
while (n <= stop) {
- /* Purify reports a benign UMR here sometimes, because we
- * don't initialize the OP() slot of a node when that node
- * is occupied by just the trailing null of the string in
- * an EXACT node */
if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
OP(n) = OPTIMIZED;
NEXT_OFF(n) = 0;
}
n++;
}
-#endif
-
+#endif
}
+ /* Follow the next-chain of the current node and optimize
+ away all the NOTHINGs from it. */
if (OP(scan) != CURLYX) {
int max = (reg_off_by_arg[OP(scan)]
? I32_MAX
else
NEXT_OFF(scan) = off;
}
+ /* The principal pseudo-switch. Cannot be a switch, since we
+ look into several different things. */
if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
|| OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
next = regnext(scan);
if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
I32 max1 = 0, min1 = I32_MAX, num = 0;
+ struct regnode_charclass_class accum;
- if (flags & SCF_DO_SUBSTR)
- scan_commit(data);
+ if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
+ scan_commit(data); /* Cannot merge strings after this. */
+ if (flags & SCF_DO_STCLASS)
+ cl_init_zero(&accum);
while (OP(scan) == code) {
- I32 deltanext, minnext;
+ I32 deltanext, minnext, f = 0;
+ struct regnode_charclass_class this_class;
num++;
data_fake.flags = 0;
scan = NEXTOPER(scan);
if (code != BRANCH)
scan = NEXTOPER(scan);
- /* We suppose the run is continuous, last=next...*/
+ if (flags & SCF_DO_STCLASS) {
+ cl_init(&this_class);
+ data_fake.start_class = &this_class;
+ f = SCF_DO_STCLASS_AND;
+ }
+ /* we suppose the run is continuous, last=next...*/
minnext = study_chunk(&scan, &deltanext, next,
- &data_fake, 0);
+ &data_fake, f);
if (min1 > minnext)
min1 = minnext;
if (max1 < minnext + deltanext)
data->flags |= SF_HAS_EVAL;
if (data)
data->whilem_c = data_fake.whilem_c;
+ if (flags & SCF_DO_STCLASS)
+ cl_or(&accum, &this_class);
if (code == SUSPEND)
break;
}
}
min += min1;
delta += max1 - min1;
+ if (flags & SCF_DO_STCLASS_OR) {
+ cl_or(data->start_class, &accum);
+ if (min1) {
+ cl_and(data->start_class, &and_with);
+ flags &= ~SCF_DO_STCLASS;
+ }
+ }
+ else if (flags & SCF_DO_STCLASS_AND) {
+ cl_and(data->start_class, &accum);
+ if (min1)
+ flags &= ~SCF_DO_STCLASS;
+ }
}
else if (code == BRANCHJ) /* single branch is optimized. */
scan = NEXTOPER(NEXTOPER(scan));
data->pos_min += l; /* As in the first entry. */
data->flags &= ~SF_BEFORE_EOL;
}
+ if (flags & SCF_DO_STCLASS_AND) {
+ /* Check whether it is compatible with what we know already! */
+ int compat = 1;
+
+ if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
+ && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
+ && (!(data->start_class->flags & ANYOF_FOLD)
+ || !ANYOF_BITMAP_TEST(data->start_class,
+ PL_fold[*STRING(scan)])))
+ compat = 0;
+ ANYOF_CLASS_ZERO(data->start_class);
+ ANYOF_BITMAP_ZERO(data->start_class);
+ if (compat)
+ ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
+ data->start_class->flags &= ~ANYOF_EOS;
+ }
+ else if (flags & SCF_DO_STCLASS_OR) {
+ /* false positive possible if the class is case-folded */
+ ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
+ data->start_class->flags &= ~ANYOF_EOS;
+ cl_and(data->start_class, &and_with);
+ }
+ flags &= ~SCF_DO_STCLASS;
}
- else if (PL_regkind[(U8)OP(scan)] == EXACT) {
+ else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
I32 l = STR_LEN(scan);
+
+ /* Search for fixed substrings supports EXACT only. */
if (flags & SCF_DO_SUBSTR)
scan_commit(data);
if (UTF) {
min += l;
if (data && (flags & SCF_DO_SUBSTR))
data->pos_min += l;
+ if (flags & SCF_DO_STCLASS_AND) {
+ /* Check whether it is compatible with what we know already! */
+ int compat = 1;
+
+ if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
+ && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan))
+ && !ANYOF_BITMAP_TEST(data->start_class,
+ PL_fold[*STRING(scan)]))
+ compat = 0;
+ ANYOF_CLASS_ZERO(data->start_class);
+ ANYOF_BITMAP_ZERO(data->start_class);
+ if (compat) {
+ ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
+ data->start_class->flags &= ~ANYOF_EOS;
+ data->start_class->flags |= ANYOF_FOLD;
+ if (OP(scan) == EXACTFL)
+ data->start_class->flags |= ANYOF_LOCALE;
+ }
+ }
+ else if (flags & SCF_DO_STCLASS_OR) {
+ if (data->start_class->flags & ANYOF_FOLD) {
+ /* false positive possible if the class is case-folded.
+ Assume that the locale settings are the same... */
+ ANYOF_BITMAP_SET(data->start_class, *STRING(scan));
+ data->start_class->flags &= ~ANYOF_EOS;
+ }
+ cl_and(data->start_class, &and_with);
+ }
+ flags &= ~SCF_DO_STCLASS;
}
else if (strchr((char*)PL_varies,OP(scan))) {
I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
+ I32 f = flags;
regnode *oscan = scan;
-
+ struct regnode_charclass_class this_class;
+ struct regnode_charclass_class *oclass = NULL;
+
switch (PL_regkind[(U8)OP(scan)]) {
- case WHILEM:
+ case WHILEM: /* End of (?:...)* . */
scan = NEXTOPER(scan);
goto finish;
case PLUS:
- if (flags & SCF_DO_SUBSTR) {
+ if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
next = NEXTOPER(scan);
- if (OP(next) == EXACT) {
+ if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
mincount = 1;
maxcount = REG_INFTY;
next = regnext(scan);
min++;
/* Fall through. */
case STAR:
+ if (flags & SCF_DO_STCLASS) {
+ mincount = 0;
+ maxcount = REG_INFTY;
+ next = regnext(scan);
+ scan = NEXTOPER(scan);
+ goto do_curly;
+ }
is_inf = is_inf_internal = 1;
scan = regnext(scan);
if (flags & SCF_DO_SUBSTR) {
- scan_commit(data);
+ scan_commit(data); /* Cannot extend fixed substrings */
data->longest = &(data->longest_float);
}
goto optimize_curly_tail;
scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
do_curly:
if (flags & SCF_DO_SUBSTR) {
- if (mincount == 0) scan_commit(data);
+ if (mincount == 0) scan_commit(data); /* Cannot extend fixed substrings */
pos_before = data->pos_min;
}
if (data) {
if (is_inf)
data->flags |= SF_IS_INF;
}
+ if (flags & SCF_DO_STCLASS) {
+ cl_init(&this_class);
+ oclass = data->start_class;
+ data->start_class = &this_class;
+ f |= SCF_DO_STCLASS_AND;
+ f &= ~SCF_DO_STCLASS_OR;
+ }
+
/* This will finish on WHILEM, setting scan, or on NULL: */
minnext = study_chunk(&scan, &deltanext, last, data,
mincount == 0
- ? (flags & ~SCF_DO_SUBSTR) : flags);
+ ? (f & ~SCF_DO_SUBSTR) : f);
+
+ if (flags & SCF_DO_STCLASS)
+ data->start_class = oclass;
+ if (mincount == 0 || minnext == 0) {
+ if (flags & SCF_DO_STCLASS_OR) {
+ cl_or(data->start_class, &this_class);
+ }
+ else if (flags & SCF_DO_STCLASS_AND) {
+ /* Switch to OR mode: cache the old value of
+ * data->start_class */
+ StructCopy(data->start_class, &and_with,
+ struct regnode_charclass_class);
+ flags &= ~SCF_DO_STCLASS_AND;
+ StructCopy(&this_class, data->start_class,
+ struct regnode_charclass_class);
+ flags |= SCF_DO_STCLASS_OR;
+ data->start_class->flags |= ANYOF_EOS;
+ }
+ } else { /* Non-zero len */
+ if (flags & SCF_DO_STCLASS_OR) {
+ cl_or(data->start_class, &this_class);
+ cl_and(data->start_class, &and_with);
+ }
+ else if (flags & SCF_DO_STCLASS_AND)
+ cl_and(data->start_class, &this_class);
+ flags &= ~SCF_DO_STCLASS;
+ }
if (!scan) /* It was not CURLYX, but CURLY. */
scan = next;
if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0)
data->pos_delta += - counted * deltanext +
(minnext + deltanext) * maxcount - minnext * mincount;
if (mincount != maxcount) {
+ /* Cannot extend fixed substrings found inside
+ the group. */
scan_commit(data);
if (mincount && last_str) {
sv_setsv(data->last_found, last_str);
NEXT_OFF(oscan) += NEXT_OFF(next);
}
continue;
- default: /* REF only? */
+ default: /* REF and CLUMP only? */
if (flags & SCF_DO_SUBSTR) {
- scan_commit(data);
+ scan_commit(data); /* Cannot expect anything... */
data->longest = &(data->longest_float);
}
is_inf = is_inf_internal = 1;
+ if (flags & SCF_DO_STCLASS_OR)
+ cl_anything(data->start_class);
+ flags &= ~SCF_DO_STCLASS;
break;
}
}
else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) {
+ int value;
+
if (flags & SCF_DO_SUBSTR) {
scan_commit(data);
data->pos_min++;
}
min++;
+ if (flags & SCF_DO_STCLASS) {
+ data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
+
+ /* Some of the logic below assumes that switching
+ locale on will only add false positives. */
+ switch (PL_regkind[(U8)OP(scan)]) {
+ case ANYUTF8:
+ case SANY:
+ case SANYUTF8:
+ case ALNUMUTF8:
+ case ANYOFUTF8:
+ case ALNUMLUTF8:
+ case NALNUMUTF8:
+ case NALNUMLUTF8:
+ case SPACEUTF8:
+ case NSPACEUTF8:
+ case SPACELUTF8:
+ case NSPACELUTF8:
+ case DIGITUTF8:
+ case NDIGITUTF8:
+ default:
+ do_default:
+ /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
+ if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
+ cl_anything(data->start_class);
+ break;
+ case REG_ANY:
+ if (OP(scan) == SANY)
+ goto do_default;
+ if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
+ value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
+ || (data->start_class->flags & ANYOF_CLASS));
+ cl_anything(data->start_class);
+ }
+ if (flags & SCF_DO_STCLASS_AND || !value)
+ ANYOF_BITMAP_CLEAR(data->start_class,'\n');
+ break;
+ case ANYOF:
+ if (flags & SCF_DO_STCLASS_AND)
+ cl_and(data->start_class,
+ (struct regnode_charclass_class*)scan);
+ else
+ cl_or(data->start_class,
+ (struct regnode_charclass_class*)scan);
+ break;
+ case ALNUM:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (!(data->start_class->flags & ANYOF_LOCALE)) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
+ for (value = 0; value < 256; value++)
+ if (!isALNUM(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
+ else {
+ for (value = 0; value < 256; value++)
+ if (isALNUM(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ case ALNUML:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
+ }
+ else {
+ ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
+ data->start_class->flags |= ANYOF_LOCALE;
+ }
+ break;
+ case NALNUM:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (!(data->start_class->flags & ANYOF_LOCALE)) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
+ for (value = 0; value < 256; value++)
+ if (isALNUM(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
+ else {
+ for (value = 0; value < 256; value++)
+ if (!isALNUM(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ case NALNUML:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
+ }
+ else {
+ data->start_class->flags |= ANYOF_LOCALE;
+ ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
+ }
+ break;
+ case SPACE:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (!(data->start_class->flags & ANYOF_LOCALE)) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
+ for (value = 0; value < 256; value++)
+ if (!isSPACE(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
+ else {
+ for (value = 0; value < 256; value++)
+ if (isSPACE(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ case SPACEL:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
+ }
+ else {
+ data->start_class->flags |= ANYOF_LOCALE;
+ ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
+ }
+ break;
+ case NSPACE:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (!(data->start_class->flags & ANYOF_LOCALE)) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
+ for (value = 0; value < 256; value++)
+ if (isSPACE(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
+ else {
+ for (value = 0; value < 256; value++)
+ if (!isSPACE(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ case NSPACEL:
+ if (flags & SCF_DO_STCLASS_AND) {
+ if (data->start_class->flags & ANYOF_LOCALE) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
+ for (value = 0; value < 256; value++)
+ if (!isSPACE(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ }
+ else {
+ data->start_class->flags |= ANYOF_LOCALE;
+ ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
+ }
+ break;
+ case DIGIT:
+ if (flags & SCF_DO_STCLASS_AND) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
+ for (value = 0; value < 256; value++)
+ if (!isDIGIT(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
+ else {
+ for (value = 0; value < 256; value++)
+ if (isDIGIT(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ case NDIGIT:
+ if (flags & SCF_DO_STCLASS_AND) {
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
+ for (value = 0; value < 256; value++)
+ if (isDIGIT(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
+ }
+ else {
+ if (data->start_class->flags & ANYOF_LOCALE)
+ ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
+ else {
+ for (value = 0; value < 256; value++)
+ if (!isDIGIT(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ break;
+ }
+ if (flags & SCF_DO_STCLASS_OR)
+ cl_and(data->start_class, &and_with);
+ flags &= ~SCF_DO_STCLASS;
+ }
}
else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
data->flags |= (OP(scan) == MEOL
? SF_BEFORE_MEOL
: SF_BEFORE_SEOL);
}
- else if (PL_regkind[(U8)OP(scan)] == BRANCHJ
- && (scan->flags || data)
+ else if ( PL_regkind[(U8)OP(scan)] == BRANCHJ
+ /* Lookbehind, or need to calculate parens/evals/stclass: */
+ && (scan->flags || data || (flags & SCF_DO_STCLASS))
&& (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
+ /* Lookahead/lookbehind */
I32 deltanext, minnext;
regnode *nscan;
+ struct regnode_charclass_class intrnl;
+ int f = 0;
data_fake.flags = 0;
if (data)
data_fake.whilem_c = data->whilem_c;
+ if ( flags & SCF_DO_STCLASS && !scan->flags
+ && OP(scan) == IFMATCH ) { /* Lookahead */
+ cl_init(&intrnl);
+ data_fake.start_class = &intrnl;
+ f = SCF_DO_STCLASS_AND;
+ }
next = regnext(scan);
nscan = NEXTOPER(NEXTOPER(scan));
- minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0);
+ minnext = study_chunk(&nscan, &deltanext, last, &data_fake, f);
if (scan->flags) {
if (deltanext) {
FAIL("variable length lookbehind not implemented");
data->flags |= SF_HAS_EVAL;
if (data)
data->whilem_c = data_fake.whilem_c;
+ if (f) {
+ int was = (data->start_class->flags & ANYOF_EOS);
+
+ cl_and(data->start_class, &intrnl);
+ if (was)
+ data->start_class->flags |= ANYOF_EOS;
+ }
}
else if (OP(scan) == OPEN) {
pars++;
data->longest = &(data->longest_float);
}
is_inf = is_inf_internal = 1;
+ if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
+ cl_anything(data->start_class);
}
/* Else: zero-length, ignore. */
scan = regnext(scan);
data->flags |= SF_HAS_PAR;
data->flags &= ~SF_IN_PAR;
}
+ if (flags & SCF_DO_STCLASS_OR)
+ cl_and(data->start_class, &and_with);
return min;
}
DEBUG_r(if (!PL_colorset) reginitcolors());
DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
PL_colors[4],PL_colors[5],PL_colors[0],
- xend - exp, PL_regprecomp, PL_colors[1]));
+ (int)(xend - exp), PL_regprecomp, PL_colors[1]));
PL_regflags = pm->op_pmflags;
PL_regsawback = 0;
PL_regprecomp = Nullch;
return(NULL);
}
- DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize));
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)PL_regsize));
/* Small enough for pointer-storage convention?
If extralen==0, this means that we will not need long jumps. */
Newz(1004, r->substrs, 1, struct reg_substr_data);
StructCopy(&zero_scan_data, &data, scan_data_t);
+ /* XXXX Should not we check for something else? Usually it is OPEN1... */
if (OP(scan) != BRANCH) { /* Only one top-level choice. */
I32 fake;
STRLEN longest_float_length, longest_fixed_length;
+ struct regnode_charclass_class ch_class;
+ int stclass_flag;
first = scan;
/* Skip introductions and multiplicators >= 1. */
while ((OP(first) == OPEN && (sawopen = 1)) ||
+ /* An OR of *one* alternative - should not happen now. */
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
(OP(first) == PLUS) ||
(OP(first) == MINMOD) ||
+ /* An {n,m} with n>0 */
(PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
if (OP(first) == PLUS)
sawplus = 1;
/* Starting-point info. */
again:
- if (OP(first) == EXACT); /* Empty, get anchored substr later. */
- else if (strchr((char*)PL_simple+4,OP(first)))
+ if (PL_regkind[(U8)OP(first)] == EXACT) {
+ if (OP(first) == EXACT); /* Empty, get anchored substr later. */
+ else if ((OP(first) == EXACTF || OP(first) == EXACTFL)
+ && !UTF)
+ r->regstclass = first;
+ }
+ else if (strchr((char*)PL_simple,OP(first)))
r->regstclass = first;
else if (PL_regkind[(U8)OP(first)] == BOUND ||
PL_regkind[(U8)OP(first)] == NBOUND)
r->reganch |= ROPT_SKIP;
/* Scan is after the zeroth branch, first is atomic matcher. */
- DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n",
- first - scan + 1));
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
+ (IV)(first - scan + 1)));
/*
* If there's something expensive in the r.e., find the
* longest literal string that must appear and make it the
data.last_found = newSVpvn("",0);
data.longest = &(data.longest_fixed);
first = scan;
-
+ if (!r->regstclass) {
+ cl_init(&ch_class);
+ data.start_class = &ch_class;
+ stclass_flag = SCF_DO_STCLASS_AND;
+ } else /* XXXX Check for BOUND? */
+ stclass_flag = 0;
+
minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */
- &data, SCF_DO_SUBSTR);
+ &data, SCF_DO_SUBSTR | stclass_flag);
if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed)
&& data.last_start_min == 0 && data.last_end > 0
&& !PL_seen_zerolen
SvREFCNT_dec(data.longest_fixed);
longest_fixed_length = 0;
}
+ if (r->regstclass
+ && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == ANYUTF8
+ || OP(r->regstclass) == SANYUTF8 || OP(r->regstclass) == SANY))
+ r->regstclass = NULL;
+ if ((!r->anchored_substr || r->anchored_offset) && stclass_flag
+ && !(data.start_class->flags & ANYOF_EOS)
+ && !cl_is_anything(data.start_class)) {
+ SV *sv;
+ I32 n = add_data(1, "f");
+
+ New(1006, PL_regcomp_rx->data->data[n], 1,
+ struct regnode_charclass_class);
+ StructCopy(data.start_class,
+ (struct regnode_charclass_class*)PL_regcomp_rx->data->data[n],
+ struct regnode_charclass_class);
+ r->regstclass = (regnode*)PL_regcomp_rx->data->data[n];
+ r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
+ DEBUG_r((sv = sv_newmortal(),
+ regprop(sv, (regnode*)data.start_class),
+ PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+ SvPVX(sv))));
+ }
/* A temporary algorithm prefers floated substr to fixed one to dig more info. */
if (longest_fixed_length > longest_float_length) {
else {
/* Several toplevels. Best we can is to set minlen. */
I32 fake;
+ struct regnode_charclass_class ch_class;
DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
scan = r->program + 1;
- minlen = study_chunk(&scan, &fake, scan + PL_regsize, &data, 0);
+ cl_init(&ch_class);
+ data.start_class = &ch_class;
+ minlen = study_chunk(&scan, &fake, scan + PL_regsize, &data, SCF_DO_STCLASS_AND);
r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
+ if (!(data.start_class->flags & ANYOF_EOS)
+ && !cl_is_anything(data.start_class)) {
+ SV *sv;
+ I32 n = add_data(1, "f");
+
+ New(1006, PL_regcomp_rx->data->data[n], 1,
+ struct regnode_charclass_class);
+ StructCopy(data.start_class,
+ (struct regnode_charclass_class*)PL_regcomp_rx->data->data[n],
+ struct regnode_charclass_class);
+ r->regstclass = (regnode*)PL_regcomp_rx->data->data[n];
+ r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
+ DEBUG_r((sv = sv_newmortal(),
+ regprop(sv, (regnode*)data.start_class),
+ PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+ SvPVX(sv))));
+ }
}
r->minlen = minlen;
if (!e)
FAIL("Missing right brace on \\x{}");
else if (UTF) {
- ender = scan_hex(p + 1, e - p, &numlen);
+ ender = (UV)scan_hex(p + 1, e - p, &numlen);
if (numlen + len >= 127) { /* numlen is generous */
p--;
goto loopdone;
FAIL("Can't use \\x{} without 'use utf8' declaration");
}
else {
- ender = scan_hex(p, 2, &numlen);
+ ender = (UV)scan_hex(p, 2, &numlen);
p += numlen;
}
break;
case '5': case '6': case '7': case '8':case '9':
if (*p == '0' ||
(isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
- ender = scan_oct(p, 3, &numlen);
+ ender = (UV)scan_oct(p, 3, &numlen);
p += numlen;
}
else {
{
dTHR;
char *posixcc = 0;
- I32 namedclass = -1;
+ I32 namedclass = OOB_NAMEDCLASS;
if (value == '[' && PL_regcomp_parse + 1 < PL_regxend &&
/* I smell either [: or [= or [. -- POSIX has been here, right? */
STATIC void
S_checkposixcc(pTHX)
{
- if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY &&
+ if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) &&
(*PL_regcomp_parse == ':' ||
*PL_regcomp_parse == '=' ||
*PL_regcomp_parse == '.')) {
S_regclass(pTHX)
{
dTHR;
- register char *opnd, *s;
- register I32 value;
+ register UV value;
register I32 lastvalue = OOB_CHAR8;
register I32 range = 0;
register regnode *ret;
I32 numlen;
I32 namedclass;
char *rangebegin;
+ bool need_class = 0;
- s = opnd = MASK(PL_regcode);
ret = reg_node(ANYOF);
- for (value = 0; value < ANYOF_SIZE; value++)
- REGC(0, s++);
+ if (SIZE_ONLY)
+ PL_regsize += ANYOF_SKIP;
+ else {
+ ret->flags = 0;
+ ANYOF_BITMAP_ZERO(ret);
+ PL_regcode += ANYOF_SKIP;
+ if (FOLD)
+ ANYOF_FLAGS(ret) |= ANYOF_FOLD;
+ if (LOC)
+ ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
+ }
if (*PL_regcomp_parse == '^') { /* Complement of range. */
PL_regnaughty++;
PL_regcomp_parse++;
if (!SIZE_ONLY)
- ANYOF_FLAGS(opnd) |= ANYOF_INVERT;
- }
- if (!SIZE_ONLY) {
- PL_regcode += ANY_SKIP;
- if (FOLD)
- ANYOF_FLAGS(opnd) |= ANYOF_FOLD;
- if (LOC)
- ANYOF_FLAGS(opnd) |= ANYOF_LOCALE;
- }
- else {
- PL_regsize += ANY_SKIP;
+ ANYOF_FLAGS(ret) |= ANYOF_INVERT;
}
- checkposixcc();
+ if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
goto skipcond; /* allow 1st char to be ] or - */
case 'e': value = '\033'; break;
case 'a': value = '\007'; break;
case 'x':
- value = scan_hex(PL_regcomp_parse, 2, &numlen);
+ value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
PL_regcomp_parse += numlen;
break;
case 'c':
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- value = scan_oct(--PL_regcomp_parse, 3, &numlen);
+ value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
PL_regcomp_parse += numlen;
break;
default:
}
}
if (namedclass > OOB_NAMEDCLASS) {
+ if (!need_class && !SIZE_ONLY)
+ ANYOF_CLASS_ZERO(ret);
+ need_class = 1;
if (range) { /* a-\d, a-[:digit:] */
if (!SIZE_ONLY) {
if (ckWARN(WARN_UNSAFE))
PL_regcomp_parse - rangebegin,
PL_regcomp_parse - rangebegin,
rangebegin);
- ANYOF_BITMAP_SET(opnd, lastvalue);
- ANYOF_BITMAP_SET(opnd, '-');
+ ANYOF_BITMAP_SET(ret, lastvalue);
+ ANYOF_BITMAP_SET(ret, '-');
}
range = 0; /* this is not a true range */
}
switch (namedclass) {
case ANYOF_ALNUM:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_ALNUM);
+ ANYOF_CLASS_SET(ret, ANYOF_ALNUM);
else {
for (value = 0; value < 256; value++)
if (isALNUM(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NALNUM:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NALNUM);
+ ANYOF_CLASS_SET(ret, ANYOF_NALNUM);
else {
for (value = 0; value < 256; value++)
if (!isALNUM(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_SPACE:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_SPACE);
+ ANYOF_CLASS_SET(ret, ANYOF_SPACE);
else {
for (value = 0; value < 256; value++)
if (isSPACE(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NSPACE:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NSPACE);
+ ANYOF_CLASS_SET(ret, ANYOF_NSPACE);
else {
for (value = 0; value < 256; value++)
if (!isSPACE(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_DIGIT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_DIGIT);
+ ANYOF_CLASS_SET(ret, ANYOF_DIGIT);
else {
for (value = '0'; value <= '9'; value++)
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NDIGIT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NDIGIT);
+ ANYOF_CLASS_SET(ret, ANYOF_NDIGIT);
else {
for (value = 0; value < '0'; value++)
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
for (value = '9' + 1; value < 256; value++)
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NALNUMC:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NALNUMC);
+ ANYOF_CLASS_SET(ret, ANYOF_NALNUMC);
else {
for (value = 0; value < 256; value++)
if (!isALNUMC(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_ALNUMC:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_ALNUMC);
+ ANYOF_CLASS_SET(ret, ANYOF_ALNUMC);
else {
for (value = 0; value < 256; value++)
if (isALNUMC(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_ALPHA:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_ALPHA);
+ ANYOF_CLASS_SET(ret, ANYOF_ALPHA);
else {
for (value = 0; value < 256; value++)
if (isALPHA(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NALPHA:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NALPHA);
+ ANYOF_CLASS_SET(ret, ANYOF_NALPHA);
else {
for (value = 0; value < 256; value++)
if (!isALPHA(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_ASCII:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_ASCII);
+ ANYOF_CLASS_SET(ret, ANYOF_ASCII);
else {
+#ifdef ASCIIish
for (value = 0; value < 128; value++)
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
+#else /* EBCDIC */
+ for (value = 0; value < 256; value++)
+ if (isASCII(value))
+ ANYOF_BITMAP_SET(ret, value);
+#endif /* EBCDIC */
}
break;
case ANYOF_NASCII:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NASCII);
+ ANYOF_CLASS_SET(ret, ANYOF_NASCII);
else {
+#ifdef ASCIIish
for (value = 128; value < 256; value++)
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
+#else /* EBCDIC */
+ for (value = 0; value < 256; value++)
+ if (!isASCII(value))
+ ANYOF_BITMAP_SET(ret, value);
+#endif /* EBCDIC */
}
break;
case ANYOF_CNTRL:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_CNTRL);
+ ANYOF_CLASS_SET(ret, ANYOF_CNTRL);
else {
for (value = 0; value < 256; value++)
if (isCNTRL(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
lastvalue = OOB_CHAR8;
break;
case ANYOF_NCNTRL:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NCNTRL);
+ ANYOF_CLASS_SET(ret, ANYOF_NCNTRL);
else {
for (value = 0; value < 256; value++)
if (!isCNTRL(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_GRAPH:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_GRAPH);
+ ANYOF_CLASS_SET(ret, ANYOF_GRAPH);
else {
for (value = 0; value < 256; value++)
if (isGRAPH(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NGRAPH:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NGRAPH);
+ ANYOF_CLASS_SET(ret, ANYOF_NGRAPH);
else {
for (value = 0; value < 256; value++)
if (!isGRAPH(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_LOWER:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_LOWER);
+ ANYOF_CLASS_SET(ret, ANYOF_LOWER);
else {
for (value = 0; value < 256; value++)
if (isLOWER(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NLOWER:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NLOWER);
+ ANYOF_CLASS_SET(ret, ANYOF_NLOWER);
else {
for (value = 0; value < 256; value++)
if (!isLOWER(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_PRINT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_PRINT);
+ ANYOF_CLASS_SET(ret, ANYOF_PRINT);
else {
for (value = 0; value < 256; value++)
if (isPRINT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NPRINT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NPRINT);
+ ANYOF_CLASS_SET(ret, ANYOF_NPRINT);
else {
for (value = 0; value < 256; value++)
if (!isPRINT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_PUNCT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_PUNCT);
+ ANYOF_CLASS_SET(ret, ANYOF_PUNCT);
else {
for (value = 0; value < 256; value++)
if (isPUNCT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NPUNCT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NPUNCT);
+ ANYOF_CLASS_SET(ret, ANYOF_NPUNCT);
else {
for (value = 0; value < 256; value++)
if (!isPUNCT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_UPPER:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_UPPER);
+ ANYOF_CLASS_SET(ret, ANYOF_UPPER);
else {
for (value = 0; value < 256; value++)
if (isUPPER(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NUPPER:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NUPPER);
+ ANYOF_CLASS_SET(ret, ANYOF_NUPPER);
else {
for (value = 0; value < 256; value++)
if (!isUPPER(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_XDIGIT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_XDIGIT);
+ ANYOF_CLASS_SET(ret, ANYOF_XDIGIT);
else {
for (value = 0; value < 256; value++)
if (isXDIGIT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
case ANYOF_NXDIGIT:
if (LOC)
- ANYOF_CLASS_SET(opnd, ANYOF_NXDIGIT);
+ ANYOF_CLASS_SET(ret, ANYOF_NXDIGIT);
else {
for (value = 0; value < 256; value++)
if (!isXDIGIT(value))
- ANYOF_BITMAP_SET(opnd, value);
+ ANYOF_BITMAP_SET(ret, value);
}
break;
default:
break;
}
if (LOC)
- ANYOF_FLAGS(opnd) |= ANYOF_CLASS;
+ ANYOF_FLAGS(ret) |= ANYOF_CLASS;
continue;
}
}
PL_regcomp_parse - rangebegin,
rangebegin);
if (!SIZE_ONLY)
- ANYOF_BITMAP_SET(opnd, '-');
+ ANYOF_BITMAP_SET(ret, '-');
} else
range = 1;
continue; /* do it next time */
if (isLOWER(lastvalue)) {
for (i = lastvalue; i <= value; i++)
if (isLOWER(i))
- ANYOF_BITMAP_SET(opnd, i);
+ ANYOF_BITMAP_SET(ret, i);
} else {
for (i = lastvalue; i <= value; i++)
if (isUPPER(i))
- ANYOF_BITMAP_SET(opnd, i);
+ ANYOF_BITMAP_SET(ret, i);
}
}
else
#endif
for ( ; lastvalue <= value; lastvalue++)
- ANYOF_BITMAP_SET(opnd, lastvalue);
+ ANYOF_BITMAP_SET(ret, lastvalue);
}
range = 0;
}
+ if (need_class) {
+ if (SIZE_ONLY)
+ PL_regsize += ANYOF_CLASS_ADD_SKIP;
+ else
+ PL_regcode += ANYOF_CLASS_ADD_SKIP;
+ }
/* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
if (!SIZE_ONLY &&
- (ANYOF_FLAGS(opnd) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) {
+ (ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) {
for (value = 0; value < 256; ++value) {
- if (ANYOF_BITMAP_TEST(opnd, value)) {
+ if (ANYOF_BITMAP_TEST(ret, value)) {
I32 cf = PL_fold[value];
- ANYOF_BITMAP_SET(opnd, cf);
+ ANYOF_BITMAP_SET(ret, cf);
}
}
- ANYOF_FLAGS(opnd) &= ~ANYOF_FOLD;
+ ANYOF_FLAGS(ret) &= ~ANYOF_FOLD;
}
/* optimize inverted simple patterns (e.g. [^a-z]) */
- if (!SIZE_ONLY && (ANYOF_FLAGS(opnd) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
+ if (!SIZE_ONLY && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
- opnd[ANYOF_BITMAP_OFFSET + value] ^= ANYOF_FLAGS_ALL;
- ANYOF_FLAGS(opnd) = 0;
+ ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL;
+ ANYOF_FLAGS(ret) = 0;
}
return ret;
}
S_regclassutf8(pTHX)
{
dTHR;
- register char *opnd, *e;
- register U32 value;
+ register char *e;
+ register UV value;
register U32 lastvalue = OOB_UTF8;
register I32 range = 0;
register regnode *ret;
listsv = newSVpvn("# comment\n",10);
}
- checkposixcc();
+ if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
goto skipcond; /* allow 1st char to be ] or - */
e = strchr(PL_regcomp_parse++, '}');
if (!e)
FAIL("Missing right brace on \\x{}");
- value = scan_hex(PL_regcomp_parse,
+ value = (UV)scan_hex(PL_regcomp_parse,
e - PL_regcomp_parse,
&numlen);
PL_regcomp_parse = e + 1;
}
else {
- value = scan_hex(PL_regcomp_parse, 2, &numlen);
+ value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
PL_regcomp_parse += numlen;
}
break;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- value = scan_oct(--PL_regcomp_parse, 3, &numlen);
+ value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
PL_regcomp_parse += numlen;
break;
default:
if (OP(node) == OPTIMIZED)
goto after_print;
regprop(sv, node);
- PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start,
- 2*l + 1, "", SvPVX(sv));
+ PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
+ (int)(2*l + 1), "", SvPVX(sv));
if (next == NULL) /* Next ptr. */
PerlIO_printf(Perl_debug_log, "(0)");
else
- PerlIO_printf(Perl_debug_log, "(%d)", next - start);
+ PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start));
(void)PerlIO_putc(Perl_debug_log, '\n');
after_print:
if (PL_regkind[(U8)op] == BRANCHJ) {
}
else if (op == ANYOF) {
node = NEXTOPER(node);
- node += ANY_SKIP;
+ node += ANYOF_SKIP;
}
else if (PL_regkind[(U8)op] == EXACT) {
/* Literal string, where present. */
/* Header fields of interest. */
if (r->anchored_substr)
- PerlIO_printf(Perl_debug_log, "anchored `%s%.*s%s'%s at %d ",
+ PerlIO_printf(Perl_debug_log,
+ "anchored `%s%.*s%s'%s at %"IVdf" ",
PL_colors[0],
- SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0),
+ (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)),
SvPVX(r->anchored_substr),
PL_colors[1],
SvTAIL(r->anchored_substr) ? "$" : "",
- r->anchored_offset);
+ (IV)r->anchored_offset);
if (r->float_substr)
- PerlIO_printf(Perl_debug_log, "floating `%s%.*s%s'%s at %d..%u ",
+ PerlIO_printf(Perl_debug_log,
+ "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ",
PL_colors[0],
- SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0),
+ (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)),
SvPVX(r->float_substr),
PL_colors[1],
SvTAIL(r->float_substr) ? "$" : "",
- r->float_min_offset, r->float_max_offset);
+ (IV)r->float_min_offset, (UV)r->float_max_offset);
if (r->check_substr)
PerlIO_printf(Perl_debug_log,
r->check_substr == r->float_substr
#endif /* DEBUGGING */
}
+STATIC void
+S_put_byte(pTHX_ SV *sv, int c)
+{
+ if (c <= ' ' || c == 127 || c == 255)
+ Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
+ else if (c == '-' || c == ']' || c == '\\' || c == '^')
+ Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
+ else
+ Perl_sv_catpvf(aTHX_ sv, "%c", c);
+}
+
/*
- regprop - printable representation of opcode
*/
Perl_sv_catpvf(aTHX_ sv, "%d", ARG(o)); /* Parenth number */
else if (k == LOGICAL)
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
+ else if (k == ANYOF) {
+ int i, rangestart = -1;
+ const char * const out[] = { /* Should be syncronized with
+ a table in regcomp.h */
+ "\\w",
+ "\\W",
+ "\\s",
+ "\\S",
+ "\\d",
+ "\\D",
+ "[:alnum:]",
+ "[:^alnum:]",
+ "[:alpha:]",
+ "[:^alpha:]",
+ "[:ascii:]",
+ "[:^ascii:]",
+ "[:ctrl:]",
+ "[:^ctrl:]",
+ "[:graph:]",
+ "[:^graph:]",
+ "[:lower:]",
+ "[:^lower:]",
+ "[:print:]",
+ "[:^print:]",
+ "[:punct:]",
+ "[:^punct:]",
+ "[:upper:]",
+ "[:!upper:]",
+ "[:xdigit:]",
+ "[:^xdigit:]"
+ };
+
+ if (o->flags & ANYOF_LOCALE)
+ sv_catpv(sv, "{loc}");
+ if (o->flags & ANYOF_FOLD)
+ sv_catpv(sv, "{i}");
+ Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
+ if (o->flags & ANYOF_INVERT)
+ sv_catpv(sv, "^");
+ for (i = 0; i <= 256; i++) {
+ if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
+ if (rangestart == -1)
+ rangestart = i;
+ } else if (rangestart != -1) {
+ if (i <= rangestart + 3)
+ for (; rangestart < i; rangestart++)
+ put_byte(sv, rangestart);
+ else {
+ put_byte(sv, rangestart);
+ sv_catpv(sv, "-");
+ put_byte(sv, i - 1);
+ }
+ rangestart = -1;
+ }
+ }
+ if (o->flags & ANYOF_CLASS)
+ for (i = 0; i < sizeof(out)/sizeof(char*); i++)
+ if (ANYOF_CLASS_TEST(o,i))
+ sv_catpv(sv, out[i]);
+ Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
+ }
else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags);
#endif /* DEBUGGING */
case 's':
SvREFCNT_dec((SV*)r->data->data[n]);
break;
+ case 'f':
+ Safefree(r->data->data[n]);
+ break;
case 'p':
new_comppad = (AV*)r->data->data[n];
break;
SAVEPPTR(PL_reginput); /* String-input pointer. */
SAVEPPTR(PL_regbol); /* Beginning of input, for ^ check. */
SAVEPPTR(PL_regeol); /* End of input, for $ check. */
- SAVESPTR(PL_regstartp); /* Pointer to startp array. */
- SAVESPTR(PL_regendp); /* Ditto for endp. */
- SAVESPTR(PL_reglastparen); /* Similarly for lastparen. */
+ SAVEVPTR(PL_regstartp); /* Pointer to startp array. */
+ SAVEVPTR(PL_regendp); /* Ditto for endp. */
+ SAVEVPTR(PL_reglastparen); /* Similarly for lastparen. */
SAVEPPTR(PL_regtill); /* How far we are required to go. */
- SAVEI32(PL_regprev); /* char before regbol, \n if none */
- SAVESPTR(PL_reg_start_tmp); /* from regexec.c */
+ SAVEI8(PL_regprev); /* char before regbol, \n if none */
+ SAVEVPTR(PL_reg_start_tmp); /* from regexec.c */
PL_reg_start_tmp = 0;
SAVEFREEPV(PL_reg_start_tmp);
SAVEI32(PL_reg_start_tmpl); /* from regexec.c */
PL_reg_start_tmpl = 0;
- SAVESPTR(PL_regdata);
+ SAVEVPTR(PL_regdata);
SAVEI32(PL_reg_flags); /* from regexec.c */
SAVEI32(PL_reg_eval_set); /* from regexec.c */
SAVEI32(PL_regnarrate); /* from regexec.c */
- SAVESPTR(PL_regprogram); /* from regexec.c */
+ SAVEVPTR(PL_regprogram); /* from regexec.c */
SAVEINT(PL_regindent); /* from regexec.c */
- SAVESPTR(PL_regcc); /* from regexec.c */
- SAVESPTR(PL_curcop);
- SAVESPTR(PL_regcomp_rx); /* from regcomp.c */
+ SAVEVPTR(PL_regcc); /* from regexec.c */
+ SAVEVPTR(PL_curcop);
+ SAVEVPTR(PL_regcomp_rx); /* from regcomp.c */
SAVEI32(PL_regseen); /* from regcomp.c */
SAVEI32(PL_regsawback); /* Did we see \1, ...? */
SAVEI32(PL_regnaughty); /* How bad is this pattern? */
- SAVESPTR(PL_regcode); /* Code-emit pointer; ®dummy = don't */
+ SAVEVPTR(PL_regcode); /* Code-emit pointer; ®dummy = don't */
SAVEPPTR(PL_regxend); /* End of input for compile */
SAVEPPTR(PL_regcomp_parse); /* Input-scan pointer. */
- SAVESPTR(PL_reg_call_cc); /* from regexec.c */
- SAVESPTR(PL_reg_re); /* from regexec.c */
+ SAVEVPTR(PL_reg_call_cc); /* from regexec.c */
+ SAVEVPTR(PL_reg_re); /* from regexec.c */
SAVEPPTR(PL_reg_ganch); /* from regexec.c */
SAVESPTR(PL_reg_sv); /* from regexec.c */
- SAVESPTR(PL_reg_magic); /* from regexec.c */
+ SAVEVPTR(PL_reg_magic); /* from regexec.c */
SAVEI32(PL_reg_oldpos); /* from regexec.c */
- SAVESPTR(PL_reg_oldcurpm); /* from regexec.c */
- SAVESPTR(PL_reg_curpm); /* from regexec.c */
+ SAVEVPTR(PL_reg_oldcurpm); /* from regexec.c */
+ SAVEVPTR(PL_reg_curpm); /* from regexec.c */
#ifdef DEBUGGING
SAVEPPTR(PL_reg_starttry); /* from regexec.c */
#endif
}
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#undef this
#define this pPerl
U16 arg2;
};
+#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */
+#define ANYOF_CLASSBITMAP_SIZE 4
+
+struct regnode_charclass {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+ char bitmap[ANYOF_BITMAP_SIZE];
+};
+
+struct regnode_charclass_class {
+ U8 flags;
+ U8 type;
+ U16 next_off;
+ char bitmap[ANYOF_BITMAP_SIZE];
+ char classflags[ANYOF_CLASSBITMAP_SIZE];
+};
+
/* XXX fix this description.
Impose a limit of REG_INFTY on various pattern matching operations
to limit stack growth and to avoid "infinite" recursions.
#define SIZE_ONLY (PL_regcode == &PL_regdummy)
-/* Flags for first parameter byte [0] of ANYOF */
+/* Flags for node->flags of ANYOF */
#define ANYOF_CLASS 0x08
#define ANYOF_INVERT 0x04
#define ANYOF_FOLD 0x02
#define ANYOF_LOCALE 0x01
-/* Character classes for bytes [1..4] of ANYOF */
+/* Used for regstclass only */
+#define ANYOF_EOS 0x10 /* Can match an empty string too */
+
+/* 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, utf8::IsWord, isALNUM() */
#define ANYOF_NALNUM 1
/* Utility macros for the bitmap and classes of ANYOF */
-#define ANYOF_OPND_SIZE 1
-#define ANYOF_CLASS_SIZE 4
-#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */
-#define ANYOF_SIZE (ANYOF_OPND_SIZE+ANYOF_CLASS_SIZE+ANYOF_BITMAP_SIZE)
+#define ANYOF_SIZE (sizeof(struct regnode_charclass))
+#define ANYOF_CLASS_SIZE (sizeof(struct regnode_charclass_class))
-#define ANYOF_FLAGS(p) ((p)[0])
+#define ANYOF_FLAGS(p) ((p)->flags)
#define ANYOF_FLAGS_ALL 0xff
#define ANYOF_BIT(c) (1 << ((c) & 7))
-#define ANYOF_CLASS_OFFSET ANYOF_OPND_SIZE
-#define ANYOF_CLASS_BYTE(p, c) ((p)[ANYOF_CLASS_OFFSET + (((c) >> 3) & 3)])
+#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_BITMAP_OFFSET (ANYOF_CLASS_OFFSET+ANYOF_CLASS_SIZE)
-#define ANYOF_BITMAP_BYTE(p, c) ((p)[ANYOF_BITMAP_OFFSET + (((c) >> 3) & 31)])
+#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 ANY_SKIP ((ANYOF_SIZE - 1)/sizeof(regnode) + 1)
+#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.
/* These are needed since we do not localize EVAL nodes: */
# define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, \
- " Setting an EVAL scope, savestack=%i\n", \
- PL_savestack_ix)); lastcp = PL_savestack_ix
+ " Setting an EVAL scope, savestack=%"IVdf"\n", \
+ (IV)PL_savestack_ix)); lastcp = PL_savestack_ix
# define REGCP_UNWIND DEBUG_r(lastcp != PL_savestack_ix ? \
PerlIO_printf(Perl_debug_log, \
- " Clearing an EVAL scope, savestack=%i..%i\n", \
- lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
+ " Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
+ (IV)lastcp, (IV)PL_savestack_ix) : 0); regcpblow(lastcp)
STATIC char *
S_regcppop(pTHX)
PL_regendp[paren] = tmps;
DEBUG_r(
PerlIO_printf(Perl_debug_log,
- " restoring \\%d to %d(%d)..%d%s\n",
- paren, PL_regstartp[paren],
- PL_reg_start_tmp[paren] - PL_bostr,
- PL_regendp[paren],
+ " restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
+ (UV)paren, (IV)PL_regstartp[paren],
+ (IV)(PL_reg_start_tmp[paren] - PL_bostr),
+ (IV)PL_regendp[paren],
(paren > *PL_reglastparen ? "(no)" : ""));
);
}
DEBUG_r(
if (*PL_reglastparen + 1 <= PL_regnpar) {
PerlIO_printf(Perl_debug_log,
- " restoring \\%d..\\%d to undef\n",
- *PL_reglastparen + 1, PL_regnpar);
+ " restoring \\%"IVdf"..\\%"IVdf" to undef\n",
+ (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
}
);
for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
/* XXXX We assume that strpos is strbeg unless sv. */
+/* XXXX Some places assume that there is a fixed substring.
+ An update may be needed if optimizer marks as "INTUITable"
+ RExen without fixed substrings. Similarly, it is assumed that
+ lengths of all the strings are no more than minlen, thus they
+ cannot come from lookahead.
+ (Or minlen should take into account lookahead.) */
+
/* A failure to find a constant substring means that there is no need to make
an expensive call to REx engine, thus we celebrate a failure. Similarly,
finding a substring too deep into the string means that less calls to
b) Fixed substring;
c) Whether we are anchored (beginning-of-line or \G);
d) First node (of those at offset 0) which may distingush positions;
- We use 'a', 'b', multiline-part of 'c', and try to find a position in the
+ We use a)b)d) and multiline-part of c), and try to find a position in the
string which does not contradict any of them.
*/
+/* Most of decisions we do here should have been done at compile time.
+ The nodes of the REx which we used for the search should have been
+ deleted from the finite automaton. */
+
char *
Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
char *strend, U32 flags, re_scream_pos_data *data)
char *t;
I32 ml_anch;
char *tmp;
- register char *other_last = Nullch;
+ register char *other_last = Nullch; /* other substr checked before this */
+ char *check_at; /* check substr found at this pos */
#ifdef DEBUGGING
char *i_strpos = strpos;
#endif
PL_colors[1],
(strlen(prog->precomp) > 60 ? "..." : ""),
PL_colors[0],
- (strend - strpos > 60 ? 60 : strend - strpos),
+ (int)(strend - strpos > 60 ? 60 : strend - strpos),
strpos, PL_colors[1],
(strend - strpos > 60 ? "..." : ""))
);
DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n"));
goto fail;
}
+ check = prog->check_substr;
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|| ( (prog->reganch & ROPT_ANCH_BOL)
}
PL_regeol = strend; /* Used in HOP() */
s = HOPc(strpos, prog->check_offset_min);
- if (SvTAIL(prog->check_substr)) {
- slen = SvCUR(prog->check_substr); /* >= 1 */
+ if (SvTAIL(check)) {
+ slen = SvCUR(check); /* >= 1 */
if ( strend - s > slen || strend - s < slen - 1
|| (strend - s == slen && strend[-1] != '\n')) {
}
/* Now should match s[0..slen-2] */
slen--;
- if (slen && (*SvPVX(prog->check_substr) != *s
+ if (slen && (*SvPVX(check) != *s
|| (slen > 1
- && memNE(SvPVX(prog->check_substr), s, slen)))) {
+ && memNE(SvPVX(check), s, slen)))) {
report_neq:
DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
goto fail_finish;
}
}
- else if (*SvPVX(prog->check_substr) != *s
- || ((slen = SvCUR(prog->check_substr)) > 1
- && memNE(SvPVX(prog->check_substr), s, slen)))
+ else if (*SvPVX(check) != *s
+ || ((slen = SvCUR(check)) > 1
+ && memNE(SvPVX(check), s, slen)))
goto report_neq;
goto success_at_start;
}
/* Match is anchored, but substr is not anchored wrt beg-of-str. */
s = strpos;
start_shift = prog->check_offset_min; /* okay to underestimate on CC */
- /* Should be nonnegative! */
end_shift = prog->minlen - start_shift -
- CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+ CHR_SVLEN(check) + (SvTAIL(check) != 0);
if (!ml_anch) {
- I32 end = prog->check_offset_max + CHR_SVLEN(prog->check_substr)
- - (SvTAIL(prog->check_substr) != 0);
+ I32 end = prog->check_offset_max + CHR_SVLEN(check)
+ - (SvTAIL(check) != 0);
I32 eshift = strend - s - end;
if (end_shift < eshift)
start_shift = prog->check_offset_min; /* okay to underestimate on CC */
/* Should be nonnegative! */
end_shift = prog->minlen - start_shift -
- CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+ CHR_SVLEN(check) + (SvTAIL(check) != 0);
}
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
Perl_croak(aTHX_ "panic: end_shift");
#endif
- check = prog->check_substr;
restart:
/* Find a possible match in the region s..strend by looking for
the "check" substring in the region corrected by start/end_shift. */
(s ? "Found" : "Did not find"),
((check == prog->anchored_substr) ? "anchored" : "floating"),
PL_colors[0],
- SvCUR(check) - (SvTAIL(check)!=0), SvPVX(check),
+ (int)(SvCUR(check) - (SvTAIL(check)!=0)),
+ SvPVX(check),
PL_colors[1], (SvTAIL(check) ? "$" : ""),
(s ? " at offset " : "...\n") ) );
if (!s)
goto fail_finish;
+ check_at = s;
+
/* Finish the diagnostic message */
DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
/* Take into account the "other" substring. */
/* XXXX May be hopelessly wrong for UTF... */
if (!other_last)
- other_last = strpos - 1;
+ other_last = strpos;
if (check == prog->float_substr) {
do_other_anchored:
{
else
t = strpos;
t += prog->anchored_offset;
- if (t <= other_last)
- t = other_last + 1;
+ if (t < other_last) /* These positions already checked */
+ t = other_last;
PL_bostr = tmp;
last2 = last1 = strend - prog->minlen;
if (last < last1)
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s anchored substr `%s%.*s%s'%s",
(s ? "Found" : "Contradicts"),
PL_colors[0],
- SvCUR(prog->anchored_substr)
- - (SvTAIL(prog->anchored_substr)!=0),
+ (int)(SvCUR(prog->anchored_substr)
+ - (SvTAIL(prog->anchored_substr)!=0)),
SvPVX(prog->anchored_substr),
PL_colors[1], (SvTAIL(prog->anchored_substr) ? "$" : "")));
if (!s) {
", trying floating at offset %ld...\n",
(long)(s1 + 1 - i_strpos)));
PL_regeol = strend; /* Used in HOP() */
- other_last = last1 + prog->anchored_offset;
+ other_last = last1 + prog->anchored_offset + 1;
s = HOPc(last, 1);
goto restart;
}
DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
(long)(s - i_strpos)));
t = s - prog->anchored_offset;
- other_last = s - 1;
+ other_last = s + 1;
s = s1;
if (t == strpos)
goto try_at_start;
if (last - t > prog->float_max_offset)
last = t + prog->float_max_offset;
s = t + prog->float_min_offset;
- if (s <= other_last)
- s = other_last + 1;
+ if (s < other_last)
+ s = other_last;
/* XXXX It is not documented what units *_offsets are in. Assume bytes. */
/* fbm_instr() takes into account exact value of end-of-str
if the check is SvTAIL(ed). Since false positives are OK,
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
(s ? "Found" : "Contradicts"),
PL_colors[0],
- SvCUR(prog->float_substr)
- - (SvTAIL(prog->float_substr)!=0),
+ (int)(SvCUR(prog->float_substr)
+ - (SvTAIL(prog->float_substr)!=0)),
SvPVX(prog->float_substr),
PL_colors[1], (SvTAIL(prog->float_substr) ? "$" : "")));
if (!s) {
DEBUG_r(PerlIO_printf(Perl_debug_log,
", trying anchored starting at offset %ld...\n",
(long)(s1 + 1 - i_strpos)));
- other_last = last;
+ other_last = last + 1;
PL_regeol = strend; /* Used in HOP() */
s = HOPc(t, 1);
goto restart;
else {
DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
(long)(s - i_strpos)));
- other_last = s - 1;
+ other_last = s + 1;
s = s1;
if (t == strpos)
goto try_at_start;
);
success_at_start:
if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */
+ && prog->check_substr /* Could be deleted already */
&& --BmUSEFUL(prog->check_substr) < 0
- && prog->check_substr == prog->float_substr) { /* boo */
+ && prog->check_substr == prog->float_substr)
+ {
/* If flags & SOMETHING - do not do it many times on the same match */
SvREFCNT_dec(prog->check_substr);
prog->check_substr = Nullsv; /* disable */
prog->float_substr = Nullsv; /* clear */
s = strpos;
+ /* XXXX This is a remnant of the old implementation. It
+ looks wasteful, since now INTUIT can use many
+ other heuristics. */
prog->reganch &= ~RE_USE_INTUIT;
}
else
s = strpos;
}
+ /* Last resort... */
+ /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
+ if (prog->regstclass) {
+ /* minlen == 0 is possible if regstclass is \b or \B,
+ and the fixed substr is ''$.
+ Since minlen is already taken into account, s+1 is before strend;
+ accidentally, minlen >= 1 guaranties no false positives at s + 1
+ even for \b or \B. But (minlen? 1 : 0) below assumes that
+ regstclass does not come from lookahead... */
+ /* If regstclass takes bytelength more than 1: If charlength==1, OK.
+ This leaves EXACTF only, which is dealt with in find_byclass(). */
+ int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
+ ? STR_LEN(prog->regstclass)
+ : 1);
+ char *endpos = (prog->anchored_substr || ml_anch)
+ ? s + (prog->minlen? cl_l : 0)
+ : (prog->float_substr ? check_at - start_shift + cl_l
+ : strend) ;
+ char *startpos = sv ? strend - SvCUR(sv) : s;
+
+ t = s;
+ s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
+ if (!s) {
+#ifdef DEBUGGING
+ char *what;
+#endif
+ if (endpos == strend) {
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Could not match STCLASS...\n") );
+ goto fail;
+ }
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "This position contradicts STCLASS...\n") );
+ if ((prog->reganch & ROPT_ANCH) && !ml_anch)
+ goto fail;
+ /* Contradict one of substrings */
+ if (prog->anchored_substr) {
+ if (prog->anchored_substr == check) {
+ DEBUG_r( what = "anchored" );
+ hop_and_restart:
+ PL_regeol = strend; /* Used in HOP() */
+ s = HOPc(t, 1);
+ if (s + start_shift + end_shift > strend) {
+ /* XXXX Should be taken into account earlier? */
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Could not match STCLASS...\n") );
+ goto fail;
+ }
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Trying %s substr starting at offset %ld...\n",
+ what, (long)(s + start_shift - i_strpos)) );
+ goto restart;
+ }
+ /* Have both, check_string is floating */
+ if (t + start_shift >= check_at) /* Contradicts floating=check */
+ goto retry_floating_check;
+ /* Recheck anchored substring, but not floating... */
+ s = check_at;
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Trying anchored substr starting at offset %ld...\n",
+ (long)(other_last - i_strpos)) );
+ goto do_other_anchored;
+ }
+ if (!prog->float_substr) { /* Could have been deleted */
+ if (ml_anch) {
+ s = t = t + 1;
+ goto try_at_offset;
+ }
+ goto fail;
+ }
+ /* Check is floating subtring. */
+ retry_floating_check:
+ t = check_at - start_shift;
+ DEBUG_r( what = "floating" );
+ goto hop_and_restart;
+ }
+ DEBUG_r( if (t != s)
+ PerlIO_printf(Perl_debug_log,
+ "By STCLASS: moving %ld --> %ld\n",
+ (long)(t - i_strpos), (long)(s - i_strpos));
+ else
+ PerlIO_printf(Perl_debug_log,
+ "Does not contradict STCLASS...\n") );
+ }
DEBUG_r(PerlIO_printf(Perl_debug_log, "%sGuessed:%s match at offset %ld\n",
PL_colors[4], PL_colors[5], (long)(s - i_strpos)) );
return s;
fail_finish: /* Substring not found */
- BmUSEFUL(prog->check_substr) += 5; /* hooray */
+ if (prog->check_substr) /* could be removed already */
+ BmUSEFUL(prog->check_substr) += 5; /* hooray */
fail:
DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
PL_colors[4],PL_colors[5]));
return Nullch;
}
-/*
- - regexec_flags - match a regexp against a string
- */
-I32
-Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
- char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
-/* strend: pointer to null at end of string */
-/* strbeg: real beginning of string */
-/* minend: end of match must be >=minend after stringarg. */
-/* data: May be used for some additional optimizations. */
-/* nosave: For optimizations. */
+/* We know what class REx starts with. Try to find this position... */
+STATIC char *
+S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun)
{
- dTHR;
- register char *s;
- register regnode *c;
- register char *startpos = stringarg;
- register I32 tmp;
- I32 minlen; /* must match at least this many chars */
- I32 dontbother = 0; /* how many characters not to try at end */
- I32 start_shift = 0; /* Offset of the start to find
- constant substr. */ /* CC */
- I32 end_shift = 0; /* Same for the end. */ /* CC */
- I32 scream_pos = -1; /* Internal iterator of scream. */
- char *scream_olds;
- SV* oreplsv = GvSV(PL_replgv);
-
- PL_regcc = 0;
-
- cache_re(prog);
-#ifdef DEBUGGING
- PL_regnarrate = PL_debug & 512;
-#endif
-
- /* Be paranoid... */
- if (prog == NULL || startpos == NULL) {
- Perl_croak(aTHX_ "NULL regexp parameter");
- return 0;
- }
-
- minlen = prog->minlen;
- if (strend - startpos < minlen) goto phooey;
-
- if (startpos == strbeg) /* is ^ valid at stringarg? */
- PL_regprev = '\n';
- else {
- PL_regprev = (U32)stringarg[-1];
- if (!PL_multiline && PL_regprev == '\n')
- PL_regprev = '\0'; /* force ^ to NOT match */
- }
-
- /* Check validity of program. */
- if (UCHARAT(prog->program) != REG_MAGIC) {
- Perl_croak(aTHX_ "corrupted regexp program");
- }
-
- PL_reg_flags = 0;
- PL_reg_eval_set = 0;
- PL_reg_maxiter = 0;
-
- if (prog->reganch & ROPT_UTF8)
- PL_reg_flags |= RF_utf8;
-
- /* Mark beginning of line for ^ and lookbehind. */
- PL_regbol = startpos;
- PL_bostr = strbeg;
- PL_reg_sv = sv;
-
- /* Mark end of line for $ (and such) */
- PL_regeol = strend;
-
- /* see how far we have to get to not match where we matched before */
- PL_regtill = startpos+minend;
-
- /* We start without call_cc context. */
- PL_reg_call_cc = 0;
-
- /* If there is a "must appear" string, look for it. */
- s = startpos;
-
- if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
- MAGIC *mg;
-
- if (flags & REXEC_IGNOREPOS) /* Means: check only at start */
- PL_reg_ganch = startpos;
- else if (sv && SvTYPE(sv) >= SVt_PVMG
- && SvMAGIC(sv)
- && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) {
- PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
- if (prog->reganch & ROPT_ANCH_GPOS) {
- if (s > PL_reg_ganch)
- goto phooey;
- s = PL_reg_ganch;
- }
- }
- else /* pos() not defined */
- PL_reg_ganch = strbeg;
- }
-
- if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
- re_scream_pos_data d;
-
- d.scream_olds = &scream_olds;
- d.scream_pos = &scream_pos;
- s = re_intuit_start(prog, sv, s, strend, flags, &d);
- if (!s)
- goto phooey; /* not present */
- }
-
- DEBUG_r( if (!PL_colorset) reginitcolors() );
- DEBUG_r(PerlIO_printf(Perl_debug_log,
- "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
- PL_colors[4],PL_colors[5],PL_colors[0],
- prog->precomp,
- PL_colors[1],
- (strlen(prog->precomp) > 60 ? "..." : ""),
- PL_colors[0],
- (strend - startpos > 60 ? 60 : strend - startpos),
- startpos, PL_colors[1],
- (strend - startpos > 60 ? "..." : ""))
- );
-
- /* Simplest case: anchored match need be tried only once. */
- /* [unless only anchor is BOL and multiline is set] */
- if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
- if (s == startpos && regtry(prog, startpos))
- goto got_it;
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
- || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
- {
- char *end;
-
- if (minlen)
- dontbother = minlen - 1;
- end = HOPc(strend, -dontbother) - 1;
- /* for multiline we only have to try after newlines */
- if (prog->check_substr) {
- if (s == startpos)
- goto after_try;
- while (1) {
- if (regtry(prog, s))
- goto got_it;
- after_try:
- if (s >= end)
- goto phooey;
- s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
- if (!s)
- goto phooey;
- }
- } else {
- if (s > startpos)
- s--;
- while (s < end) {
- if (*s++ == '\n') { /* don't need PL_utf8skip here */
- if (regtry(prog, s))
- goto got_it;
- }
- }
- }
- }
- goto phooey;
- } else if (prog->reganch & ROPT_ANCH_GPOS) {
- if (regtry(prog, PL_reg_ganch))
- goto got_it;
- goto phooey;
- }
+ I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
+ char *m;
+ int ln;
+ int c1;
+ int c2;
+ char *e;
+ register I32 tmp = 1; /* Scratch variable? */
- /* Messy cases: unanchored match. */
- if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
- /* we have /x+whatever/ */
- /* it must be a one character string (XXXX Except UTF?) */
- char ch = SvPVX(prog->anchored_substr)[0];
- if (UTF) {
+ /* We know what class it must start with. */
+ switch (OP(c)) {
+ case ANYOFUTF8:
while (s < strend) {
- if (*s == ch) {
- if (regtry(prog, s)) goto got_it;
- s += UTF8SKIP(s);
- while (s < strend && *s == ch)
- s += UTF8SKIP(s);
+ if (REGINCLASSUTF8(c, (U8*)s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
}
+ else
+ tmp = 1;
s += UTF8SKIP(s);
}
- }
- else {
+ break;
+ case ANYOF:
while (s < strend) {
- if (*s == ch) {
- if (regtry(prog, s)) goto got_it;
+ if (REGINCLASS(c, *s)) {
+ if (tmp && (norun || regtry(prog, s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
+ s++;
+ }
+ break;
+ case EXACTF:
+ m = STRING(c);
+ ln = STR_LEN(c);
+ c1 = *m;
+ c2 = PL_fold[c1];
+ goto do_exactf;
+ case EXACTFL:
+ m = STRING(c);
+ ln = STR_LEN(c);
+ c1 = *m;
+ c2 = PL_fold_locale[c1];
+ do_exactf:
+ e = strend - ln;
+
+ if (norun && e < s)
+ e = s; /* Due to minlen logic of intuit() */
+ /* Here it is NOT UTF! */
+ if (c1 == c2) {
+ while (s <= e) {
+ if ( *s == c1
+ && (ln == 1 || !(OP(c) == EXACTF
+ ? ibcmp(s, m, ln)
+ : ibcmp_locale(s, m, ln)))
+ && (norun || regtry(prog, s)) )
+ goto got_it;
s++;
- while (s < strend && *s == ch)
- s++;
+ }
+ } else {
+ while (s <= e) {
+ if ( (*s == c1 || *s == c2)
+ && (ln == 1 || !(OP(c) == EXACTF
+ ? ibcmp(s, m, ln)
+ : ibcmp_locale(s, m, ln)))
+ && (norun || regtry(prog, s)) )
+ goto got_it;
+ s++;
+ }
+ }
+ break;
+ case BOUNDL:
+ PL_reg_flags |= RF_tainted;
+ /* FALL THROUGH */
+ case BOUND:
+ tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
+ tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
+ while (s < strend) {
+ if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
+ tmp = !tmp;
+ if ((norun || regtry(prog, s)))
+ goto got_it;
}
s++;
}
- }
- }
- /*SUPPRESS 560*/
- else if (prog->anchored_substr != Nullsv
- || (prog->float_substr != Nullsv
- && prog->float_max_offset < strend - s)) {
- SV *must = prog->anchored_substr
- ? prog->anchored_substr : prog->float_substr;
- I32 back_max =
- prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
- I32 back_min =
- prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
- I32 delta = back_max - back_min;
- char *last = HOPc(strend, /* Cannot start after this */
- -(I32)(CHR_SVLEN(must)
- - (SvTAIL(must) != 0) + back_min));
- char *last1; /* Last position checked before */
-
- if (s > PL_bostr)
- last1 = HOPc(s, -1);
- else
- last1 = s - 1; /* bogus */
-
- /* XXXX check_substr already used to find `s', can optimize if
- check_substr==must. */
- scream_pos = -1;
- dontbother = end_shift;
- strend = HOPc(strend, -dontbother);
- while ( (s <= last) &&
- ((flags & REXEC_SCREAM)
- ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg,
- end_shift, &scream_pos, 0))
- : (s = fbm_instr((unsigned char*)HOP(s, back_min),
- (unsigned char*)strend, must,
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
- if (HOPc(s, -back_max) > last1) {
- last1 = HOPc(s, -back_min);
- s = HOPc(s, -back_max);
- }
- else {
- char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
-
- last1 = HOPc(s, -back_min);
- s = t;
- }
- if (UTF) {
- while (s <= last1) {
- if (regtry(prog, s))
- goto got_it;
- s += UTF8SKIP(s);
- }
- }
- else {
- while (s <= last1) {
- if (regtry(prog, s))
- goto got_it;
- s++;
- }
- }
- }
- goto phooey;
- }
- else if (c = prog->regstclass) {
- I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
- char *cc;
-
- if (minlen)
- dontbother = minlen - 1;
- strend = HOPc(strend, -dontbother); /* don't bother with what can't match */
- tmp = 1;
- /* We know what class it must start with. */
- switch (OP(c)) {
- case ANYOFUTF8:
- cc = MASK(c);
- while (s < strend) {
- if (REGINCLASSUTF8(c, (U8*)s)) {
- if (tmp && regtry(prog, s))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += UTF8SKIP(s);
- }
- break;
- case ANYOF:
- cc = MASK(c);
- while (s < strend) {
- if (REGINCLASS(cc, *s)) {
- if (tmp && regtry(prog, s))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- break;
- case BOUNDL:
- PL_reg_flags |= RF_tainted;
- /* FALL THROUGH */
- case BOUND:
- if (minlen) {
- dontbother++;
- strend -= 1;
- }
- tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
- tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
- while (s < strend) {
- if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
- tmp = !tmp;
- if (regtry(prog, s))
- goto got_it;
- }
- s++;
- }
- if ((minlen || tmp) && regtry(prog,s))
+ if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
goto got_it;
break;
case BOUNDLUTF8:
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUNDUTF8:
- if (minlen) {
- dontbother++;
- strend = reghop_c(strend, -1);
- }
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
+ tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == BOUND ?
isALNUM_LC_utf8((U8*)s)))
{
tmp = !tmp;
- if (regtry(prog, s))
+ if ((norun || regtry(prog, s)))
goto got_it;
}
s += UTF8SKIP(s);
}
- if ((minlen || tmp) && regtry(prog,s))
+ if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
goto got_it;
break;
case NBOUNDL:
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUND:
- if (minlen) {
- dontbother++;
- strend -= 1;
- }
- tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
+ tmp = (s != startpos) ? UCHARAT(s - 1) : '\n';
tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
tmp = !tmp;
- else if (regtry(prog, s))
+ else if ((norun || regtry(prog, s)))
goto got_it;
s++;
}
- if ((minlen || !tmp) && regtry(prog,s))
+ if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
goto got_it;
break;
case NBOUNDLUTF8:
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUNDUTF8:
- if (minlen) {
- dontbother++;
+ if (prog->minlen)
strend = reghop_c(strend, -1);
- }
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
+ tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == NBOUND ?
swash_fetch(PL_utf8_alnum, (U8*)s) :
isALNUM_LC_utf8((U8*)s)))
tmp = !tmp;
- else if (regtry(prog, s))
+ else if ((norun || regtry(prog, s)))
goto got_it;
s += UTF8SKIP(s);
}
- if ((minlen || !tmp) && regtry(prog,s))
+ if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
goto got_it;
break;
case ALNUM:
while (s < strend) {
if (isALNUM(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case ALNUMUTF8:
while (s < strend) {
if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isALNUM_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isALNUM_LC_utf8((U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NALNUM:
while (s < strend) {
if (!isALNUM(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NALNUMUTF8:
while (s < strend) {
if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isALNUM_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isALNUM_LC_utf8((U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case SPACE:
while (s < strend) {
if (isSPACE(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case SPACEUTF8:
while (s < strend) {
if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isSPACE_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NSPACE:
while (s < strend) {
if (!isSPACE(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NSPACEUTF8:
while (s < strend) {
if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isSPACE_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case DIGIT:
while (s < strend) {
if (isDIGIT(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case DIGITUTF8:
while (s < strend) {
if (swash_fetch(PL_utf8_digit,(U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isDIGIT_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NDIGIT:
while (s < strend) {
if (!isDIGIT(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case NDIGITUTF8:
while (s < strend) {
if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isDIGIT_LC(*s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
PL_reg_flags |= RF_tainted;
while (s < strend) {
if (!isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
s += UTF8SKIP(s);
}
break;
+ default:
+ Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
+ break;
+ }
+ return 0;
+ got_it:
+ return s;
+}
+
+/*
+ - regexec_flags - match a regexp against a string
+ */
+I32
+Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
+ char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
+/* strend: pointer to null at end of string */
+/* strbeg: real beginning of string */
+/* minend: end of match must be >=minend after stringarg. */
+/* data: May be used for some additional optimizations. */
+/* nosave: For optimizations. */
+{
+ dTHR;
+ register char *s;
+ register regnode *c;
+ register char *startpos = stringarg;
+ register I32 tmp;
+ I32 minlen; /* must match at least this many chars */
+ I32 dontbother = 0; /* how many characters not to try at end */
+ I32 start_shift = 0; /* Offset of the start to find
+ constant substr. */ /* CC */
+ I32 end_shift = 0; /* Same for the end. */ /* CC */
+ I32 scream_pos = -1; /* Internal iterator of scream. */
+ char *scream_olds;
+ SV* oreplsv = GvSV(PL_replgv);
+
+ PL_regcc = 0;
+
+ cache_re(prog);
+#ifdef DEBUGGING
+ PL_regnarrate = PL_debug & 512;
+#endif
+
+ /* Be paranoid... */
+ if (prog == NULL || startpos == NULL) {
+ Perl_croak(aTHX_ "NULL regexp parameter");
+ return 0;
+ }
+
+ minlen = prog->minlen;
+ if (strend - startpos < minlen) goto phooey;
+
+ if (startpos == strbeg) /* is ^ valid at stringarg? */
+ PL_regprev = '\n';
+ else {
+ PL_regprev = (U32)stringarg[-1];
+ if (!PL_multiline && PL_regprev == '\n')
+ PL_regprev = '\0'; /* force ^ to NOT match */
+ }
+
+ /* Check validity of program. */
+ if (UCHARAT(prog->program) != REG_MAGIC) {
+ Perl_croak(aTHX_ "corrupted regexp program");
+ }
+
+ PL_reg_flags = 0;
+ PL_reg_eval_set = 0;
+ PL_reg_maxiter = 0;
+
+ if (prog->reganch & ROPT_UTF8)
+ PL_reg_flags |= RF_utf8;
+
+ /* Mark beginning of line for ^ and lookbehind. */
+ PL_regbol = startpos;
+ PL_bostr = strbeg;
+ PL_reg_sv = sv;
+
+ /* Mark end of line for $ (and such) */
+ PL_regeol = strend;
+
+ /* see how far we have to get to not match where we matched before */
+ PL_regtill = startpos+minend;
+
+ /* We start without call_cc context. */
+ PL_reg_call_cc = 0;
+
+ /* If there is a "must appear" string, look for it. */
+ s = startpos;
+
+ if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
+ MAGIC *mg;
+
+ if (flags & REXEC_IGNOREPOS) /* Means: check only at start */
+ PL_reg_ganch = startpos;
+ else if (sv && SvTYPE(sv) >= SVt_PVMG
+ && SvMAGIC(sv)
+ && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) {
+ PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
+ if (prog->reganch & ROPT_ANCH_GPOS) {
+ if (s > PL_reg_ganch)
+ goto phooey;
+ s = PL_reg_ganch;
+ }
+ }
+ else /* pos() not defined */
+ PL_reg_ganch = strbeg;
+ }
+
+ if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
+ re_scream_pos_data d;
+
+ d.scream_olds = &scream_olds;
+ d.scream_pos = &scream_pos;
+ s = re_intuit_start(prog, sv, s, strend, flags, &d);
+ if (!s)
+ goto phooey; /* not present */
+ }
+
+ DEBUG_r( if (!PL_colorset) reginitcolors() );
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
+ "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
+ PL_colors[4],PL_colors[5],PL_colors[0],
+ prog->precomp,
+ PL_colors[1],
+ (strlen(prog->precomp) > 60 ? "..." : ""),
+ PL_colors[0],
+ (int)(strend - startpos > 60 ? 60 : strend - startpos),
+ startpos, PL_colors[1],
+ (strend - startpos > 60 ? "..." : ""))
+ );
+
+ /* Simplest case: anchored match need be tried only once. */
+ /* [unless only anchor is BOL and multiline is set] */
+ if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
+ if (s == startpos && regtry(prog, startpos))
+ goto got_it;
+ else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+ || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
+ {
+ char *end;
+
+ if (minlen)
+ dontbother = minlen - 1;
+ end = HOPc(strend, -dontbother) - 1;
+ /* for multiline we only have to try after newlines */
+ if (prog->check_substr) {
+ if (s == startpos)
+ goto after_try;
+ while (1) {
+ if (regtry(prog, s))
+ goto got_it;
+ after_try:
+ if (s >= end)
+ goto phooey;
+ if (prog->reganch & RE_USE_INTUIT) {
+ s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
+ if (!s)
+ goto phooey;
+ }
+ else
+ s++;
+ }
+ } else {
+ if (s > startpos)
+ s--;
+ while (s < end) {
+ if (*s++ == '\n') { /* don't need PL_utf8skip here */
+ if (regtry(prog, s))
+ goto got_it;
+ }
+ }
+ }
+ }
+ goto phooey;
+ } else if (prog->reganch & ROPT_ANCH_GPOS) {
+ if (regtry(prog, PL_reg_ganch))
+ goto got_it;
+ goto phooey;
+ }
+
+ /* Messy cases: unanchored match. */
+ if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
+ /* we have /x+whatever/ */
+ /* it must be a one character string (XXXX Except UTF?) */
+ char ch = SvPVX(prog->anchored_substr)[0];
+ if (UTF) {
+ while (s < strend) {
+ if (*s == ch) {
+ if (regtry(prog, s)) goto got_it;
+ s += UTF8SKIP(s);
+ while (s < strend && *s == ch)
+ s += UTF8SKIP(s);
+ }
+ s += UTF8SKIP(s);
+ }
}
+ else {
+ while (s < strend) {
+ if (*s == ch) {
+ if (regtry(prog, s)) goto got_it;
+ s++;
+ while (s < strend && *s == ch)
+ s++;
+ }
+ s++;
+ }
+ }
+ }
+ /*SUPPRESS 560*/
+ else if (prog->anchored_substr != Nullsv
+ || (prog->float_substr != Nullsv
+ && prog->float_max_offset < strend - s)) {
+ SV *must = prog->anchored_substr
+ ? prog->anchored_substr : prog->float_substr;
+ I32 back_max =
+ prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
+ I32 back_min =
+ prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
+ I32 delta = back_max - back_min;
+ char *last = HOPc(strend, /* Cannot start after this */
+ -(I32)(CHR_SVLEN(must)
+ - (SvTAIL(must) != 0) + back_min));
+ char *last1; /* Last position checked before */
+
+ if (s > PL_bostr)
+ last1 = HOPc(s, -1);
+ else
+ last1 = s - 1; /* bogus */
+
+ /* XXXX check_substr already used to find `s', can optimize if
+ check_substr==must. */
+ scream_pos = -1;
+ dontbother = end_shift;
+ strend = HOPc(strend, -dontbother);
+ while ( (s <= last) &&
+ ((flags & REXEC_SCREAM)
+ ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg,
+ end_shift, &scream_pos, 0))
+ : (s = fbm_instr((unsigned char*)HOP(s, back_min),
+ (unsigned char*)strend, must,
+ PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ if (HOPc(s, -back_max) > last1) {
+ last1 = HOPc(s, -back_min);
+ s = HOPc(s, -back_max);
+ }
+ else {
+ char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
+
+ last1 = HOPc(s, -back_min);
+ s = t;
+ }
+ if (UTF) {
+ while (s <= last1) {
+ if (regtry(prog, s))
+ goto got_it;
+ s += UTF8SKIP(s);
+ }
+ }
+ else {
+ while (s <= last1) {
+ if (regtry(prog, s))
+ goto got_it;
+ s++;
+ }
+ }
+ }
+ goto phooey;
+ }
+ else if (c = prog->regstclass) {
+ if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
+ /* don't bother with what can't match */
+ strend = HOPc(strend, -(minlen - 1));
+ if (find_byclass(prog, c, s, strend, startpos, 0))
+ goto got_it;
}
else {
dontbother = 0;
PL_reg_eval_set = RS_init;
DEBUG_r(DEBUG_s(
- PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n",
- PL_stack_sp - PL_stack_base);
+ PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %"IVdf"\n",
+ (IV)(PL_stack_sp - PL_stack_base));
));
- SAVEINT(cxstack[cxstack_ix].blk_oldsp);
+ SAVEI32(cxstack[cxstack_ix].blk_oldsp);
cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
/* Otherwise OP_NEXTSTATE will free whatever on stack now. */
SAVETMPS;
/* Apparently this is not needed, judging by wantarray. */
- /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
+ /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
if (PL_reg_sv) {
pref0_len = pref_len;
regprop(prop, scan);
PerlIO_printf(Perl_debug_log,
- "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
- locinput - PL_bostr,
+ "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
+ (IV)(locinput - PL_bostr),
PL_colors[4], pref0_len,
locinput - pref_len, PL_colors[5],
PL_colors[2], pref_len - pref0_len,
PL_colors[0], l, locinput, PL_colors[1],
15 - l - pref_len + 1,
"",
- scan - PL_regprogram, PL_regindent*2, "",
+ (IV)(scan - PL_regprogram), PL_regindent*2, "",
SvPVX(prop));
} );
nextchr = UCHARAT(locinput);
break;
case ANYOFUTF8:
- s = MASK(scan);
if (!REGINCLASSUTF8(scan, (U8*)locinput))
sayNO;
if (locinput >= PL_regeol)
nextchr = UCHARAT(locinput);
break;
case ANYOF:
- s = MASK(scan);
if (nextchr < 0)
nextchr = UCHARAT(locinput);
- if (!REGINCLASS(s, nextchr))
+ if (!REGINCLASS(scan, nextchr))
sayNO;
if (!nextchr && locinput >= PL_regeol)
sayNO;
n = ARG(scan);
PL_op = (OP_4tree*)PL_regdata->data[n];
- DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) );
+ DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
locinput = PL_reginput;
DEBUG_r(
PerlIO_printf(Perl_debug_log,
- "%*s matched %ld times, len=%ld...\n",
- REPORT_CODE_OFF+PL_regindent*2, "", n, l)
+ "%*s matched %"IVdf" times, len=%"IVdf"...\n",
+ (int)(REPORT_CODE_OFF+PL_regindent*2), "",
+ (IV) n, (IV)l)
);
if (n >= ln) {
if (PL_regkind[(U8)OP(next)] == EXACT) {
{
DEBUG_r(
PerlIO_printf(Perl_debug_log,
- "%*s trying tail with n=%ld...\n",
- REPORT_CODE_OFF+PL_regindent*2, "", n)
+ "%*s trying tail with n=%"IVdf"...\n",
+ (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
);
if (paren) {
if (n) {
next = NULL;
break;
default:
- PerlIO_printf(Perl_error_log, "%lx %d\n",
- (unsigned long)scan, OP(scan));
+ PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
+ PTR2UV(scan), OP(scan));
Perl_croak(aTHX_ "regexp memory corruption");
}
scan = next;
{
dTHR;
register char *scan;
- register char *opnd;
register I32 c;
register char *loceol = PL_regeol;
register I32 hardcount = 0;
}
break;
case ANYOF:
- opnd = MASK(p);
- while (scan < loceol && REGINCLASS(opnd, *scan))
+ while (scan < loceol && REGINCLASS(p, *scan))
scan++;
break;
case ALNUM:
regprop(prop, p);
PerlIO_printf(Perl_debug_log,
- "%*s %s can match %ld times out of %ld...\n",
- REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
+ "%*s %s can match %"IVdf" times out of %"IVdf"...\n",
+ REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
});
return(c);
*/
STATIC bool
-S_reginclass(pTHX_ register char *p, register I32 c)
+S_reginclass(pTHX_ register regnode *p, register I32 c)
{
dTHR;
char flags = ANYOF_FLAGS(p);
}
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
#define ROPT_CHECK_ALL 0x00100
#define ROPT_LOOKBEHIND_SEEN 0x00200
#define ROPT_EVAL_SEEN 0x00400
-#define ROPT_TAINTED_SEEN 0x00800
/* 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 RE_USE_INTUIT_NOML 0x0100000 /* Best to intuit before matching */
#define RE_USE_INTUIT_ML 0x0200000
{
dTHR;
- while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) ;
+ while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) {
+ PERL_ASYNC_CHECK();
+ }
TAINT_NOT;
return 0;
}
do {
+ PERL_ASYNC_CHECK();
if (PL_debug) {
if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
- PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
- (long)PL_watchaddr, (long)PL_watchok, (long)*PL_watchaddr);
+ PerlIO_printf(Perl_debug_log,
+ "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
+ PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
+ PTR2UV(*PL_watchaddr));
DEBUG_s(debstack());
DEBUG_t(debop(PL_op));
DEBUG_P(debprof(PL_op));
Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
switch (o->op_type) {
case OP_CONST:
- PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
break;
case OP_GVSV:
case OP_GV:
- if (cGVOPo->op_gv) {
+ if (cGVOPo_gv) {
sv = NEWSV(0,0);
- gv_fullname3(sv, cGVOPo->op_gv, Nullch);
+ gv_fullname3(sv, cGVOPo_gv, Nullch);
PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
dTHR;
PL_watchaddr = addr;
PL_watchok = *addr;
- PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
- (long)PL_watchaddr, (long)PL_watchok);
+ PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
+ PTR2UV(PL_watchaddr), PTR2UV(PL_watchok));
#endif /* DEBUGGING */
}
if (empty) {
register GP *gp;
+ Newz(602, gp, 1, GP);
+
if (GvCVu(gv))
PL_sub_generation++; /* taking a method out of circulation */
- Newz(602, gp, 1, GP);
+ if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
+ gp->gp_io = newIO();
+ IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
+ }
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
- GvLINE(gv) = PL_curcop->cop_line;
+ GvLINE(gv) = CopLINE(PL_curcop);
GvEGV(gv) = gv;
}
else {
}
void
+Perl_save_I8(pTHX_ I8 *bytep)
+{
+ dTHR;
+ SSCHECK(3);
+ SSPUSHINT(*bytep);
+ SSPUSHPTR(bytep);
+ SSPUSHINT(SAVEt_I8);
+}
+
+void
Perl_save_iv(pTHX_ IV *ivp)
{
dTHR;
}
void
+Perl_save_vptr(pTHX_ void *ptr)
+{
+ dTHR;
+ SSCHECK(3);
+ SSPUSHPTR(*(char**)ptr);
+ SSPUSHPTR(ptr);
+ SSPUSHINT(SAVEt_VPTR);
+}
+
+void
Perl_save_sptr(pTHX_ SV **sptr)
{
dTHR;
#ifdef USE_THREADS
dTHR;
SV **svp = &THREADSV(i); /* XXX Change to save by offset */
- DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %u: %p %p:%s\n",
- i, svp, *svp, SvPEEK(*svp)));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
+ (UV)i, svp, *svp, SvPEEK(*svp)));
save_svref(svp);
return svp;
#else
ptr = SSPOPPTR;
*(I16*)ptr = (I16)SSPOPINT;
break;
+ case SAVEt_I8: /* I8 reference */
+ ptr = SSPOPPTR;
+ *(I8*)ptr = (I8)SSPOPINT;
+ break;
case SAVEt_IV: /* IV reference */
ptr = SSPOPPTR;
*(IV*)ptr = (IV)SSPOPIV;
ptr = SSPOPPTR;
*(SV**)ptr = (SV*)SSPOPPTR;
break;
+ case SAVEt_VPTR: /* random* reference */
case SAVEt_PPTR: /* char* reference */
ptr = SSPOPPTR;
*(char**)ptr = (char*)SSPOPPTR;
PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
if (CxTYPE(cx) != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
- PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
+ PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_oldcop));
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
- PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
+ PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_oldpm));
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
}
switch (CxTYPE(cx)) {
case CXt_NULL:
case CXt_BLOCK:
break;
+ case CXt_FORMAT:
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.cv));
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.gv));
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.dfoutgv));
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
+ (int)cx->blk_sub.hasargs);
+ break;
case CXt_SUB:
- PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n",
- (long)cx->blk_sub.cv);
- PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n",
- (long)cx->blk_sub.gv);
- PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n",
- (long)cx->blk_sub.dfoutgv);
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_sub.cv));
PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
(long)cx->blk_sub.olddepth);
PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
(int)cx->blk_sub.hasargs);
+ PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n",
+ (int)cx->blk_sub.lval);
break;
case CXt_EVAL:
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
PL_op_desc[cx->blk_eval.old_op_type]);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
cx->blk_eval.old_name);
- PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
- (long)cx->blk_eval.old_eval_root);
+ PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_eval.old_eval_root));
break;
case CXt_LOOP:
cx->blk_loop.label);
PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
(long)cx->blk_loop.resetsp);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n",
- (long)cx->blk_loop.redo_op);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n",
- (long)cx->blk_loop.next_op);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n",
- (long)cx->blk_loop.last_op);
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.redo_op));
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.next_op));
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.last_op));
PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
(long)cx->blk_loop.iterix);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n",
- (long)cx->blk_loop.iterary);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n",
- (long)cx->blk_loop.itervar);
- if (cx->blk_loop.itervar)
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
- (long)cx->blk_loop.itersave);
- PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
- (long)cx->blk_loop.iterlval);
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.iterary));
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
+ PTR2UV(CxITERVAR(cx)));
+ if (CxITERVAR(cx))
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.itersave));
+ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%"UVxf"\n",
+ PTR2UV(cx->blk_loop.iterlval));
break;
case CXt_SUBST:
(long)cx->sb_once);
PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
cx->sb_orig);
- PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n",
- (long)cx->sb_dstr);
- PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n",
- (long)cx->sb_targ);
- PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n",
- (long)cx->sb_s);
- PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n",
- (long)cx->sb_m);
- PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n",
- (long)cx->sb_strend);
- PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n",
- (long)cx->sb_rxres);
+ PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
+ PTR2UV(cx->sb_dstr));
+ PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
+ PTR2UV(cx->sb_targ));
+ PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
+ PTR2UV(cx->sb_s));
+ 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 */
#define SAVEt_ALLOC 28
#define SAVEt_GENERIC_SVREF 29
#define SAVEt_DESTRUCTOR_X 30
+#define SAVEt_VPTR 31
+#define SAVEt_I8 32
#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
* 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 SAVELONG(l) save_long(SOFT_CAST(long*)&(l))
#define SAVESPTR(s) save_sptr((SV**)&(s))
#define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s))
+#define SAVEVPTR(s) save_vptr((void*)&(s))
#define SAVEFREESV(s) save_freesv((SV*)(s))
#define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o))
#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p))
} \
} STMT_END
+#ifdef USE_ITHREADS
+# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop))
+# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop))
+#else
+# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop))
+# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop))
+#endif
+
+#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop))
+
/* 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.
if (!ok) {
if (ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,
- "Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
+ "Attempt to free non-arena SV: 0x%"UVxf,
+ PTR2UV(p));
return;
}
}
PL_sv_root = 0;
}
+void
+Perl_report_uninit(pTHX)
+{
+ if (PL_op)
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
+ " in ", PL_op_desc[PL_op->op_type]);
+ else
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
+}
+
STATIC XPVIV*
S_new_xiv(pTHX)
{
#ifdef HAS_64K_LIMIT
if (newlen >= 0x10000) {
- PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen);
+ PerlIO_printf(Perl_debug_log,
+ "Allocation too large: %"UVxf"\n", (UV)newlen);
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0;
}
}
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
#if defined(USE_LONG_DOUBLE)
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
- (unsigned long)sv, SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv)));
#else
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
- (unsigned long)sv, SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%g)\n",
+ PTR2UV(sv), SvNVX(sv)));
#endif
if (SvNVX(sv) < (NV)IV_MAX + 0.5)
SvIVX(sv) = I_V(SvNVX(sv));
else {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (SvTYPE(sv) < SVt_IV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_IV);
return 0;
}
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
- (unsigned long)sv,(long)SvIVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
+ PTR2UV(sv),SvIVX(sv)));
return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
}
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0;
}
}
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
#if defined(USE_LONG_DOUBLE)
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
- (unsigned long)sv, SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv)));
#else
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
- (unsigned long)sv, SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" 2nv(%g)\n",
+ PTR2UV(sv), SvNVX(sv)));
#endif
if (SvNVX(sv) < -0.5) {
SvIVX(sv) = I_V(SvNVX(sv));
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
if (SvTYPE(sv) < SVt_IV)
/* Typically the caller expects that sv_any is not NULL now. */
return 0;
}
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
- (unsigned long)sv,SvUVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
+ PTR2UV(sv),SvUVX(sv)));
return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
}
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
return 0;
}
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
return 0.0;
}
}
#if defined(USE_LONG_DOUBLE)
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIgldbl ")\n",
- (unsigned long)sv, SvNVX(sv));
+ PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf" num(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
#else
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log, "0x%lx num(%g)\n",
- (unsigned long)sv, SvNVX(sv));
+ PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%g)\n",
+ PTR2UV(sv), SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
#endif
else {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
if (SvTYPE(sv) < SVt_NV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_NV);
#if defined(USE_LONG_DOUBLE)
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
- (unsigned long)sv, SvNVX(sv));
+ PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
#else
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log, "0x%lx 1nv(%g)\n",
- (unsigned long)sv, SvNVX(sv));
+ PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%g)\n",
+ PTR2UV(sv), SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
#endif
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
*lp = 0;
return "";
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
*lp = 0;
return "";
}
if (ckWARN(WARN_UNINITIALIZED)
&& !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
{
- Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
}
*lp = 0;
if (SvTYPE(sv) < SVt_PV)
*lp = s - SvPVX(sv);
SvCUR_set(sv, *lp);
SvPOK_on(sv);
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
- (unsigned long)sv,SvPVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+ PTR2UV(sv),SvPVX(sv)));
return SvPVX(sv);
tokensave:
SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
if (intro) {
GP *gp;
- GvGP(dstr)->gp_refcnt--;
+ gp_free((GV*)dstr);
GvINTRO_off(dstr); /* one-shot flag */
Newz(602,gp, 1, GP);
GvGP(dstr) = gp_ref(gp);
GvSV(dstr) = NEWSV(72,0);
- GvLINE(dstr) = PL_curcop->cop_line;
+ GvLINE(dstr) = CopLINE(PL_curcop);
GvEGV(dstr) = (GV*)dstr;
}
GvMULTI_on(dstr);
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_AV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_AV_on(dstr);
+ }
break;
case SVt_PVHV:
if (intro)
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_HV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_HV_on(dstr);
+ }
break;
case SVt_PVCV:
if (intro) {
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_CV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_CV_on(dstr);
+ }
break;
case SVt_PVIO:
if (intro)
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_SV_off(dstr)
+ && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+ {
GvIMPORTED_SV_on(dstr);
+ }
break;
}
if (dref)
if (mg->mg_type == type) {
MGVTBL* vtbl = mg->mg_virtual;
*mgp = mg->mg_moremagic;
- if (vtbl && (vtbl->svt_free != NULL))
+ if (vtbl && vtbl->svt_free)
CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
if (mg->mg_ptr && mg->mg_type != 'g')
if (mg->mg_len >= 0)
{
io_close((IO*)sv, FALSE);
}
- if (IoDIRP(sv)) {
+ if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP))
PerlDir_close(IoDIRP(sv));
- IoDIRP(sv) = 0;
- }
+ IoDIRP(sv) = (DIR*)NULL;
Safefree(IoTOP_NAME(sv));
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ WARN_DEBUGGING,
- "Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv);
+ "Attempt to free temp prematurely: SV 0x%"UVxf,
+ PTR2UV(sv));
return;
}
#endif
bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */
ptr = (STDCHAR*)PerlIO_get_ptr(fp);
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+ "Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
- (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
- (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
+ "Screamer: entering: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+ PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
+ PTR2UV(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
for (;;) {
screamer:
if (cnt > 0) {
}
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+ "Screamer: going to getc, ptr=%"UVuf", cnt=%ld\n",
+ PTR2UV(ptr),(long)cnt));
PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
- (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
- (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+ "Screamer: pre: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+ PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
+ PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
/* This used to call 'filbuf' in stdio form, but as that behaves like
getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
another abstraction. */
i = PerlIO_getc(fp); /* get more characters */
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
- (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
- (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+ "Screamer: post: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+ PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
+ PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
cnt = PerlIO_get_cnt(fp);
ptr = (STDCHAR*)PerlIO_get_ptr(fp); /* reregisterize cnt and ptr */
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+ "Screamer: after getc, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
if (i == EOF) /* all done for ever? */
goto thats_really_all_folks;
if (shortbuffered)
cnt += shortbuffered;
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+ "Screamer: quitting, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
PerlIO_set_ptrcnt(fp, ptr, cnt); /* put these back or we're in trouble */
DEBUG_P(PerlIO_printf(Perl_debug_log,
- "Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
- (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
- (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+ "Screamer: end: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+ PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
+ PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
*bp = '\0';
SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */
DEBUG_P(PerlIO_printf(Perl_debug_log,
if (!SvPOK(sv)) {
SvPOK_on(sv); /* validate pointer */
SvTAINT(sv);
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
- (unsigned long)sv,SvPVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+ PTR2UV(sv),SvPVX(sv)));
}
}
return SvPVX(sv);
if (args) {
eptr = va_arg(*args, char*);
if (eptr)
+#ifdef MACOS_TRADITIONAL
+ /* On MacOS, %#s format is used for Pascal strings */
+ if (alt)
+ elen = *eptr++;
+ else
+#endif
elen = strlen(eptr);
else {
eptr = nullstr;
case 16:
if (!uv)
alt = FALSE;
- p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
+ p = (char*)((c == 'X')
+ ? "0123456789ABCDEF" : "0123456789abcdef");
do {
dig = uv & 15;
*--eptr = p[dig];
eptr = PL_efloatbuf;
elen = strlen(PL_efloatbuf);
-
-#ifdef USE_LOCALE_NUMERIC
- /*
- * User-defined locales may include arbitrary characters.
- * And, unfortunately, some (broken) systems may allow the
- * "C" locale to be overridden by a malicious user.
- * XXX This is an extreme way to cope with broken systems.
- */
- if (maybe_tainted && PL_tainting) {
- /* safe if it matches /[-+]?\d*(\.\d*)?([eE][-+]?\d*)?/ */
- if (*eptr == '-' || *eptr == '+')
- ++eptr;
- while (isDIGIT(*eptr))
- ++eptr;
- if (*eptr == '.') {
- ++eptr;
- while (isDIGIT(*eptr))
- ++eptr;
- }
- if (*eptr == 'e' || *eptr == 'E') {
- ++eptr;
- if (*eptr == '-' || *eptr == '+')
- ++eptr;
- while (isDIGIT(*eptr))
- ++eptr;
- }
- if (*eptr)
- *maybe_tainted = TRUE; /* results are suspect */
- eptr = PL_efloatbuf;
- }
-#endif /* USE_LOCALE_NUMERIC */
-
break;
/* SPECIAL */
}
}
+#if defined(USE_ITHREADS)
+
+#if defined(USE_THREADS)
+# include "error: USE_THREADS and USE_ITHREADS are incompatible"
+#endif
+
+#ifndef OpREFCNT_inc
+# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop)
+#endif
+
+#ifndef GpREFCNT_inc
+# define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
+#endif
+
+
+#define sv_dup_inc(s) SvREFCNT_inc(sv_dup(s))
+#define av_dup(s) (AV*)sv_dup((SV*)s)
+#define av_dup_inc(s) (AV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define hv_dup(s) (HV*)sv_dup((SV*)s)
+#define hv_dup_inc(s) (HV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define cv_dup(s) (CV*)sv_dup((SV*)s)
+#define cv_dup_inc(s) (CV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define io_dup(s) (IO*)sv_dup((SV*)s)
+#define io_dup_inc(s) (IO*)SvREFCNT_inc(sv_dup((SV*)s))
+#define gv_dup(s) (GV*)sv_dup((SV*)s)
+#define gv_dup_inc(s) (GV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define SAVEPV(p) (p ? savepv(p) : Nullch)
+#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch)
+
+REGEXP *
+Perl_re_dup(pTHX_ REGEXP *r)
+{
+ /* XXX fix when pmop->op_pmregexp becomes shared */
+ return ReREFCNT_inc(r);
+}
+
+PerlIO *
+Perl_fp_dup(pTHX_ PerlIO *fp, char type)
+{
+ PerlIO *ret;
+ if (!fp)
+ return (PerlIO*)NULL;
+
+ /* look for it in the table first */
+ ret = (PerlIO*)ptr_table_fetch(PL_ptr_table, fp);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
+ ret = PerlIO_fdupopen(fp);
+ ptr_table_store(PL_ptr_table, fp, ret);
+ return ret;
+}
+
+DIR *
+Perl_dirp_dup(pTHX_ DIR *dp)
+{
+ if (!dp)
+ return (DIR*)NULL;
+ /* XXX TODO */
+ return dp;
+}
+
+GP *
+Perl_gp_dup(pTHX_ GP *gp)
+{
+ GP *ret;
+ if (!gp)
+ return (GP*)NULL;
+ /* look for it in the table first */
+ ret = (GP*)ptr_table_fetch(PL_ptr_table, gp);
+ if (ret)
+ return ret;
+
+ /* create anew and remember what it is */
+ Newz(0, ret, 1, GP);
+ ptr_table_store(PL_ptr_table, gp, ret);
+
+ /* clone */
+ ret->gp_refcnt = 0; /* must be before any other dups! */
+ ret->gp_sv = sv_dup_inc(gp->gp_sv);
+ ret->gp_io = io_dup_inc(gp->gp_io);
+ ret->gp_form = cv_dup_inc(gp->gp_form);
+ ret->gp_av = av_dup_inc(gp->gp_av);
+ ret->gp_hv = hv_dup_inc(gp->gp_hv);
+ ret->gp_egv = gv_dup(gp->gp_egv); /* GvEGV is not refcounted */
+ ret->gp_cv = cv_dup_inc(gp->gp_cv);
+ ret->gp_cvgen = gp->gp_cvgen;
+ ret->gp_flags = gp->gp_flags;
+ ret->gp_line = gp->gp_line;
+ ret->gp_file = gp->gp_file; /* points to COP.cop_file */
+ return ret;
+}
+
+MAGIC *
+Perl_mg_dup(pTHX_ MAGIC *mg)
+{
+ MAGIC *mgret = (MAGIC*)NULL;
+ MAGIC *mgprev;
+ if (!mg)
+ return (MAGIC*)NULL;
+ /* look for it in the table first */
+ mgret = (MAGIC*)ptr_table_fetch(PL_ptr_table, mg);
+ if (mgret)
+ return mgret;
+
+ for (; mg; mg = mg->mg_moremagic) {
+ MAGIC *nmg;
+ Newz(0, nmg, 1, MAGIC);
+ if (!mgret)
+ mgret = nmg;
+ else
+ mgprev->mg_moremagic = nmg;
+ nmg->mg_virtual = mg->mg_virtual; /* XXX copy dynamic vtable? */
+ nmg->mg_private = mg->mg_private;
+ nmg->mg_type = mg->mg_type;
+ nmg->mg_flags = mg->mg_flags;
+ if (mg->mg_type == 'r') {
+ nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj);
+ }
+ else {
+ nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
+ ? sv_dup_inc(mg->mg_obj)
+ : sv_dup(mg->mg_obj);
+ }
+ nmg->mg_len = mg->mg_len;
+ nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */
+ if (mg->mg_ptr && mg->mg_type != 'g') {
+ if (mg->mg_len >= 0) {
+ nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len);
+ if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) {
+ AMT *amtp = (AMT*)mg->mg_ptr;
+ AMT *namtp = (AMT*)nmg->mg_ptr;
+ I32 i;
+ for (i = 1; i < NofAMmeth; i++) {
+ namtp->table[i] = cv_dup_inc(amtp->table[i]);
+ }
+ }
+ }
+ else if (mg->mg_len == HEf_SVKEY)
+ nmg->mg_ptr = (char*)sv_dup_inc((SV*)mg->mg_ptr);
+ }
+ mgprev = nmg;
+ }
+ return mgret;
+}
+
+PTR_TBL_t *
+Perl_ptr_table_new(pTHX)
+{
+ PTR_TBL_t *tbl;
+ Newz(0, tbl, 1, PTR_TBL_t);
+ tbl->tbl_max = 511;
+ tbl->tbl_items = 0;
+ Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
+ return tbl;
+}
+
+void *
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
+{
+ PTR_TBL_ENT_t *tblent;
+ UV hash = (UV)sv;
+ assert(tbl);
+ tblent = tbl->tbl_ary[hash & tbl->tbl_max];
+ for (; tblent; tblent = tblent->next) {
+ if (tblent->oldval == sv)
+ return tblent->newval;
+ }
+ return (void*)NULL;
+}
+
+void
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
+{
+ PTR_TBL_ENT_t *tblent, **otblent;
+ /* XXX this may be pessimal on platforms where pointers aren't good
+ * hash values e.g. if they grow faster in the most significant
+ * bits */
+ UV hash = (UV)oldv;
+ bool i = 1;
+
+ assert(tbl);
+ otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
+ for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
+ if (tblent->oldval == oldv) {
+ tblent->newval = newv;
+ tbl->tbl_items++;
+ return;
+ }
+ }
+ Newz(0, tblent, 1, PTR_TBL_ENT_t);
+ tblent->oldval = oldv;
+ tblent->newval = newv;
+ tblent->next = *otblent;
+ *otblent = tblent;
+ tbl->tbl_items++;
+ if (i && tbl->tbl_items > tbl->tbl_max)
+ ptr_table_split(tbl);
+}
+
+void
+Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
+{
+ PTR_TBL_ENT_t **ary = tbl->tbl_ary;
+ UV oldsize = tbl->tbl_max + 1;
+ UV newsize = oldsize * 2;
+ UV i;
+
+ Renew(ary, newsize, PTR_TBL_ENT_t*);
+ Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
+ tbl->tbl_max = --newsize;
+ tbl->tbl_ary = ary;
+ for (i=0; i < oldsize; i++, ary++) {
+ PTR_TBL_ENT_t **curentp, **entp, *ent;
+ if (!*ary)
+ continue;
+ curentp = ary + oldsize;
+ for (entp = ary, ent = *ary; ent; ent = *entp) {
+ if ((newsize & (UV)ent->oldval) != i) {
+ *entp = ent->next;
+ ent->next = *curentp;
+ *curentp = ent;
+ continue;
+ }
+ else
+ entp = &ent->next;
+ }
+ }
+}
+
+#ifdef DEBUGGING
+char *PL_watch_pvx;
+#endif
+
+SV *
+Perl_sv_dup(pTHX_ SV *sstr)
+{
+ U32 sflags;
+ int dtype;
+ int stype;
+ SV *dstr;
+
+ if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
+ return Nullsv;
+ /* look for it in the table first */
+ dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
+ if (dstr)
+ return dstr;
+
+ /* create anew and remember what it is */
+ new_SV(dstr);
+ ptr_table_store(PL_ptr_table, sstr, dstr);
+
+ /* clone */
+ SvFLAGS(dstr) = SvFLAGS(sstr);
+ SvFLAGS(dstr) &= ~SVf_OOK; /* don't propagate OOK hack */
+ SvREFCNT(dstr) = 0; /* must be before any other dups! */
+
+#ifdef DEBUGGING
+ if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
+ PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
+ PL_watch_pvx, SvPVX(sstr));
+#endif
+
+ switch (SvTYPE(sstr)) {
+ case SVt_NULL:
+ SvANY(dstr) = NULL;
+ break;
+ case SVt_IV:
+ SvANY(dstr) = new_XIV();
+ SvIVX(dstr) = SvIVX(sstr);
+ break;
+ case SVt_NV:
+ SvANY(dstr) = new_XNV();
+ SvNVX(dstr) = SvNVX(sstr);
+ break;
+ case SVt_RV:
+ SvANY(dstr) = new_XRV();
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ break;
+ case SVt_PV:
+ SvANY(dstr) = new_XPV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVIV:
+ SvANY(dstr) = new_XPVIV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVNV:
+ SvANY(dstr) = new_XPVNV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVMG:
+ SvANY(dstr) = new_XPVMG();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVBM:
+ SvANY(dstr) = new_XPVBM();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ BmRARE(dstr) = BmRARE(sstr);
+ BmUSEFUL(dstr) = BmUSEFUL(sstr);
+ BmPREVIOUS(dstr)= BmPREVIOUS(sstr);
+ break;
+ case SVt_PVLV:
+ SvANY(dstr) = new_XPVLV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */
+ LvTARGLEN(dstr) = LvTARGLEN(sstr);
+ LvTARG(dstr) = sv_dup_inc(LvTARG(sstr));
+ LvTYPE(dstr) = LvTYPE(sstr);
+ break;
+ case SVt_PVGV:
+ SvANY(dstr) = new_XPVGV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ GvNAMELEN(dstr) = GvNAMELEN(sstr);
+ GvNAME(dstr) = SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
+ GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr));
+ GvFLAGS(dstr) = GvFLAGS(sstr);
+ GvGP(dstr) = gp_dup(GvGP(sstr));
+ (void)GpREFCNT_inc(GvGP(dstr));
+ break;
+ case SVt_PVIO:
+ SvANY(dstr) = new_XPVIO();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvROK(sstr))
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ else if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
+ if (IoOFP(sstr) == IoIFP(sstr))
+ IoOFP(dstr) = IoIFP(dstr);
+ else
+ IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
+ /* PL_rsfp_filters entries have fake IoDIRP() */
+ if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
+ IoDIRP(dstr) = dirp_dup(IoDIRP(sstr));
+ else
+ IoDIRP(dstr) = IoDIRP(sstr);
+ IoLINES(dstr) = IoLINES(sstr);
+ IoPAGE(dstr) = IoPAGE(sstr);
+ IoPAGE_LEN(dstr) = IoPAGE_LEN(sstr);
+ IoLINES_LEFT(dstr) = IoLINES_LEFT(sstr);
+ IoTOP_NAME(dstr) = SAVEPV(IoTOP_NAME(sstr));
+ IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr));
+ IoFMT_NAME(dstr) = SAVEPV(IoFMT_NAME(sstr));
+ IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr));
+ IoBOTTOM_NAME(dstr) = SAVEPV(IoBOTTOM_NAME(sstr));
+ IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr));
+ IoSUBPROCESS(dstr) = IoSUBPROCESS(sstr);
+ IoTYPE(dstr) = IoTYPE(sstr);
+ IoFLAGS(dstr) = IoFLAGS(sstr);
+ break;
+ case SVt_PVAV:
+ SvANY(dstr) = new_XPVAV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
+ AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
+ if (AvARRAY((AV*)sstr)) {
+ SV **dst_ary, **src_ary;
+ SSize_t items = AvFILLp((AV*)sstr) + 1;
+
+ src_ary = AvARRAY((AV*)sstr);
+ Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+ ptr_table_store(PL_ptr_table, src_ary, dst_ary);
+ SvPVX(dstr) = (char*)dst_ary;
+ AvALLOC((AV*)dstr) = dst_ary;
+ if (AvREAL((AV*)sstr)) {
+ while (items-- > 0)
+ *dst_ary++ = sv_dup_inc(*src_ary++);
+ }
+ else {
+ while (items-- > 0)
+ *dst_ary++ = sv_dup(*src_ary++);
+ }
+ items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr);
+ while (items-- > 0) {
+ *dst_ary++ = &PL_sv_undef;
+ }
+ }
+ else {
+ SvPVX(dstr) = Nullch;
+ AvALLOC((AV*)dstr) = (SV**)NULL;
+ }
+ break;
+ case SVt_PVHV:
+ SvANY(dstr) = new_XPVHV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
+ if (HvARRAY((HV*)sstr)) {
+ HE *entry;
+ STRLEN i = 0;
+ XPVHV *dxhv = (XPVHV*)SvANY(dstr);
+ XPVHV *sxhv = (XPVHV*)SvANY(sstr);
+ Newz(0, dxhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+ while (i <= sxhv->xhv_max) {
+ ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
+ !!HvSHAREKEYS(sstr));
+ ++i;
+ }
+ dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr));
+ }
+ else {
+ SvPVX(dstr) = Nullch;
+ HvEITER((HV*)dstr) = (HE*)NULL;
+ }
+ HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
+ HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
+ break;
+ case SVt_PVFM:
+ SvANY(dstr) = new_XPVFM();
+ FmLINES(dstr) = FmLINES(sstr);
+ goto dup_pvcv;
+ /* NOTREACHED */
+ case SVt_PVCV:
+ SvANY(dstr) = new_XPVCV();
+dup_pvcv:
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPVX(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ CvSTASH(dstr) = hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */
+ CvSTART(dstr) = CvSTART(sstr);
+ CvROOT(dstr) = OpREFCNT_inc(CvROOT(sstr));
+ CvXSUB(dstr) = CvXSUB(sstr);
+ CvXSUBANY(dstr) = CvXSUBANY(sstr);
+ CvGV(dstr) = gv_dup_inc(CvGV(sstr));
+ CvDEPTH(dstr) = CvDEPTH(sstr);
+ if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
+ /* XXX padlists are real, but pretend to be not */
+ AvREAL_on(CvPADLIST(sstr));
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(sstr));
+ AvREAL_off(CvPADLIST(dstr));
+ }
+ else
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr));
+ CvFLAGS(dstr) = CvFLAGS(sstr);
+ break;
+ default:
+ Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr));
+ break;
+ }
+
+ if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
+ ++PL_sv_objcount;
+
+ return dstr;
+}
+
+PERL_CONTEXT *
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
+{
+ PERL_CONTEXT *ncxs;
+
+ if (!cxs)
+ return (PERL_CONTEXT*)NULL;
+
+ /* look for it in the table first */
+ ncxs = (PERL_CONTEXT*)ptr_table_fetch(PL_ptr_table, cxs);
+ if (ncxs)
+ return ncxs;
+
+ /* create anew and remember what it is */
+ Newz(56, ncxs, max + 1, PERL_CONTEXT);
+ ptr_table_store(PL_ptr_table, cxs, ncxs);
+
+ while (ix >= 0) {
+ PERL_CONTEXT *cx = &cxs[ix];
+ PERL_CONTEXT *ncx = &ncxs[ix];
+ ncx->cx_type = cx->cx_type;
+ if (CxTYPE(cx) == CXt_SUBST) {
+ Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
+ }
+ else {
+ ncx->blk_oldsp = cx->blk_oldsp;
+ ncx->blk_oldcop = cx->blk_oldcop;
+ ncx->blk_oldretsp = cx->blk_oldretsp;
+ ncx->blk_oldmarksp = cx->blk_oldmarksp;
+ ncx->blk_oldscopesp = cx->blk_oldscopesp;
+ ncx->blk_oldpm = cx->blk_oldpm;
+ ncx->blk_gimme = cx->blk_gimme;
+ switch (CxTYPE(cx)) {
+ case CXt_SUB:
+ ncx->blk_sub.cv = (cx->blk_sub.olddepth == 0
+ ? cv_dup_inc(cx->blk_sub.cv)
+ : cv_dup(cx->blk_sub.cv));
+ ncx->blk_sub.argarray = (cx->blk_sub.hasargs
+ ? av_dup_inc(cx->blk_sub.argarray)
+ : Nullav);
+ ncx->blk_sub.savearray = av_dup(cx->blk_sub.savearray);
+ ncx->blk_sub.olddepth = cx->blk_sub.olddepth;
+ ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ ncx->blk_sub.lval = cx->blk_sub.lval;
+ break;
+ case CXt_EVAL:
+ ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
+ ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type;
+ ncx->blk_eval.old_name = SAVEPV(cx->blk_eval.old_name);
+ ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
+ ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text);
+ break;
+ case CXt_LOOP:
+ ncx->blk_loop.label = cx->blk_loop.label;
+ ncx->blk_loop.resetsp = cx->blk_loop.resetsp;
+ ncx->blk_loop.redo_op = cx->blk_loop.redo_op;
+ ncx->blk_loop.next_op = cx->blk_loop.next_op;
+ ncx->blk_loop.last_op = cx->blk_loop.last_op;
+ ncx->blk_loop.iterdata = (CxPADLOOP(cx)
+ ? cx->blk_loop.iterdata
+ : gv_dup((GV*)cx->blk_loop.iterdata));
+ ncx->blk_loop.itersave = sv_dup_inc(cx->blk_loop.itersave);
+ ncx->blk_loop.iterlval = sv_dup_inc(cx->blk_loop.iterlval);
+ ncx->blk_loop.iterary = av_dup_inc(cx->blk_loop.iterary);
+ ncx->blk_loop.iterix = cx->blk_loop.iterix;
+ ncx->blk_loop.itermax = cx->blk_loop.itermax;
+ break;
+ case CXt_FORMAT:
+ ncx->blk_sub.cv = cv_dup(cx->blk_sub.cv);
+ ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv);
+ ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv);
+ ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ break;
+ case CXt_BLOCK:
+ case CXt_NULL:
+ break;
+ }
+ }
+ --ix;
+ }
+ return ncxs;
+}
+
+PERL_SI *
+Perl_si_dup(pTHX_ PERL_SI *si)
+{
+ PERL_SI *nsi;
+
+ if (!si)
+ return (PERL_SI*)NULL;
+
+ /* look for it in the table first */
+ nsi = (PERL_SI*)ptr_table_fetch(PL_ptr_table, si);
+ if (nsi)
+ return nsi;
+
+ /* create anew and remember what it is */
+ Newz(56, nsi, 1, PERL_SI);
+ ptr_table_store(PL_ptr_table, si, nsi);
+
+ nsi->si_stack = av_dup_inc(si->si_stack);
+ nsi->si_cxix = si->si_cxix;
+ nsi->si_cxmax = si->si_cxmax;
+ nsi->si_cxstack = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax);
+ nsi->si_type = si->si_type;
+ nsi->si_prev = si_dup(si->si_prev);
+ nsi->si_next = si_dup(si->si_next);
+ nsi->si_markoff = si->si_markoff;
+
+ return nsi;
+}
+
+#define POPINT(ss,ix) ((ss)[--(ix)].any_i32)
+#define TOPINT(ss,ix) ((ss)[ix].any_i32)
+#define POPLONG(ss,ix) ((ss)[--(ix)].any_long)
+#define TOPLONG(ss,ix) ((ss)[ix].any_long)
+#define POPIV(ss,ix) ((ss)[--(ix)].any_iv)
+#define TOPIV(ss,ix) ((ss)[ix].any_iv)
+#define POPPTR(ss,ix) ((ss)[--(ix)].any_ptr)
+#define TOPPTR(ss,ix) ((ss)[ix].any_ptr)
+#define POPDPTR(ss,ix) ((ss)[--(ix)].any_dptr)
+#define TOPDPTR(ss,ix) ((ss)[ix].any_dptr)
+#define POPDXPTR(ss,ix) ((ss)[--(ix)].any_dxptr)
+#define TOPDXPTR(ss,ix) ((ss)[ix].any_dxptr)
+
+/* XXXXX todo */
+#define pv_dup_inc(p) SAVEPV(p)
+#define pv_dup(p) SAVEPV(p)
+#define svp_dup_inc(p,pp) any_dup(p,pp)
+
+void *
+Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
+{
+ void *ret;
+
+ if (!v)
+ return (void*)NULL;
+
+ /* look for it in the table first */
+ ret = ptr_table_fetch(PL_ptr_table, v);
+ if (ret)
+ return ret;
+
+ /* see if it is part of the interpreter structure */
+ if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
+ ret = (void*)(((char*)aTHXo) + (((char*)v) - (char*)proto_perl));
+ else
+ ret = v;
+
+ return ret;
+}
+
+ANY *
+Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
+{
+ ANY *ss = proto_perl->Tsavestack;
+ I32 ix = proto_perl->Tsavestack_ix;
+ I32 max = proto_perl->Tsavestack_max;
+ ANY *nss;
+ SV *sv;
+ GV *gv;
+ AV *av;
+ HV *hv;
+ void* ptr;
+ int intval;
+ long longval;
+ GP *gp;
+ IV iv;
+ I32 i;
+ char *c;
+ void (*dptr) (void*);
+ void (*dxptr) (pTHXo_ void*);
+
+ Newz(54, nss, max, ANY);
+
+ while (ix > 0) {
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ switch (i) {
+ case SAVEt_ITEM: /* normal string */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ break;
+ case SAVEt_SV: /* scalar reference */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup_inc(gv);
+ break;
+ case SAVEt_GENERIC_SVREF: /* generic sv */
+ case SAVEt_SVREF: /* scalar reference */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */
+ break;
+ case SAVEt_AV: /* array reference */
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_HV: /* hash reference */
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_INT: /* int reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ intval = (int)POPINT(ss,ix);
+ TOPINT(nss,ix) = intval;
+ break;
+ case SAVEt_LONG: /* long reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ longval = (long)POPLONG(ss,ix);
+ TOPLONG(nss,ix) = longval;
+ break;
+ case SAVEt_I32: /* I32 reference */
+ case SAVEt_I16: /* I16 reference */
+ case SAVEt_I8: /* I8 reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_IV: /* IV reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ break;
+ case SAVEt_SPTR: /* SV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup(sv);
+ break;
+ case SAVEt_VPTR: /* random* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ break;
+ case SAVEt_PPTR: /* char* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup(c);
+ break;
+ case SAVEt_HPTR: /* HV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup(hv);
+ break;
+ case SAVEt_APTR: /* AV* reference */
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup(av);
+ break;
+ case SAVEt_NSTAB:
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup(gv);
+ break;
+ case SAVEt_GP: /* scalar reference */
+ gp = (GP*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gp = gp_dup(gp);
+ (void)GpREFCNT_inc(gp);
+ gv = (GV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gv_dup_inc(c);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup(c);
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ iv = POPIV(ss,ix);
+ TOPIV(nss,ix) = iv;
+ break;
+ case SAVEt_FREESV:
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ break;
+ case SAVEt_FREEOP:
+ ptr = POPPTR(ss,ix);
+ if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
+ /* these are assumed to be refcounted properly */
+ switch (((OP*)ptr)->op_type) {
+ case OP_LEAVESUB:
+ case OP_LEAVESUBLV:
+ case OP_LEAVEEVAL:
+ case OP_LEAVE:
+ case OP_SCOPE:
+ case OP_LEAVEWRITE:
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ break;
+ default:
+ TOPPTR(nss,ix) = Nullop;
+ break;
+ }
+ }
+ else
+ TOPPTR(nss,ix) = Nullop;
+ break;
+ case SAVEt_FREEPV:
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup_inc(c);
+ break;
+ case SAVEt_CLEARSV:
+ longval = POPLONG(ss,ix);
+ TOPLONG(nss,ix) = longval;
+ break;
+ case SAVEt_DELETE:
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup_inc(c);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_DESTRUCTOR:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
+ dptr = POPDPTR(ss,ix);
+ TOPDPTR(nss,ix) = (void (*)(void*))any_dup(dptr, proto_perl);
+ break;
+ case SAVEt_DESTRUCTOR_X:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
+ dxptr = POPDXPTR(ss,ix);
+ TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup(dxptr, proto_perl);
+ break;
+ case SAVEt_REGCONTEXT:
+ case SAVEt_ALLOC:
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ ix -= i;
+ break;
+ case SAVEt_STACK_POS: /* Position on Perl stack */
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ case SAVEt_AELEM: /* array element */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ av = (AV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av);
+ break;
+ case SAVEt_HELEM: /* hash element */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv);
+ hv = (HV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv);
+ break;
+ case SAVEt_OP:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = ptr;
+ break;
+ case SAVEt_HINTS:
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
+ default:
+ Perl_croak(aTHX_ "panic: ss_dup inconsistency");
+ }
+ }
+
+ return nss;
+}
+
+#ifdef PERL_OBJECT
+#include "XSUB.h"
+#endif
+
+PerlInterpreter *
+perl_clone(PerlInterpreter *proto_perl, UV flags)
+{
+#ifdef PERL_OBJECT
+ CPerlObj *pPerl = (CPerlObj*)proto_perl;
+#endif
+
+#ifdef PERL_IMPLICIT_SYS
+ return perl_clone_using(proto_perl, flags,
+ proto_perl->IMem,
+ proto_perl->IMemShared,
+ proto_perl->IMemParse,
+ proto_perl->IEnv,
+ proto_perl->IStdIO,
+ proto_perl->ILIO,
+ proto_perl->IDir,
+ proto_perl->ISock,
+ proto_perl->IProc);
+}
+
+PerlInterpreter *
+perl_clone_using(PerlInterpreter *proto_perl, UV flags,
+ struct IPerlMem* ipM, struct IPerlMem* ipMS,
+ struct IPerlMem* ipMP, struct IPerlEnv* ipE,
+ struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
+ struct IPerlDir* ipD, struct IPerlSock* ipS,
+ struct IPerlProc* ipP)
+{
+ /* XXX many of the string copies here can be optimized if they're
+ * constants; they need to be allocated as common memory and just
+ * their pointers copied. */
+
+ IV i;
+ SV *sv;
+ SV **svp;
+# ifdef PERL_OBJECT
+ CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
+ ipD, ipS, ipP);
+ PERL_SET_INTERP(pPerl);
+# else /* !PERL_OBJECT */
+ PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
+ PERL_SET_INTERP(my_perl);
+
+# ifdef DEBUGGING
+ memset(my_perl, 0xab, sizeof(PerlInterpreter));
+ PL_markstack = 0;
+ PL_scopestack = 0;
+ PL_savestack = 0;
+ PL_retstack = 0;
+# else /* !DEBUGGING */
+ Zero(my_perl, 1, PerlInterpreter);
+# endif /* DEBUGGING */
+
+ /* host pointers */
+ PL_Mem = ipM;
+ PL_MemShared = ipMS;
+ PL_MemParse = ipMP;
+ PL_Env = ipE;
+ PL_StdIO = ipStd;
+ PL_LIO = ipLIO;
+ PL_Dir = ipD;
+ PL_Sock = ipS;
+ PL_Proc = ipP;
+# endif /* PERL_OBJECT */
+#else /* !PERL_IMPLICIT_SYS */
+ IV i;
+ SV *sv;
+ SV **svp;
+ PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+ PERL_SET_INTERP(my_perl);
+
+# ifdef DEBUGGING
+ memset(my_perl, 0xab, sizeof(PerlInterpreter));
+ PL_markstack = 0;
+ PL_scopestack = 0;
+ PL_savestack = 0;
+ PL_retstack = 0;
+# else /* !DEBUGGING */
+ Zero(my_perl, 1, PerlInterpreter);
+# endif /* DEBUGGING */
+#endif /* PERL_IMPLICIT_SYS */
+
+ /* arena roots */
+ PL_xiv_arenaroot = NULL;
+ PL_xiv_root = NULL;
+ PL_xnv_root = NULL;
+ PL_xrv_root = NULL;
+ PL_xpv_root = NULL;
+ PL_xpviv_root = NULL;
+ PL_xpvnv_root = NULL;
+ PL_xpvcv_root = NULL;
+ PL_xpvav_root = NULL;
+ PL_xpvhv_root = NULL;
+ PL_xpvmg_root = NULL;
+ PL_xpvlv_root = NULL;
+ PL_xpvbm_root = NULL;
+ PL_he_root = NULL;
+ PL_nice_chunk = NULL;
+ PL_nice_chunk_size = 0;
+ PL_sv_count = 0;
+ PL_sv_objcount = 0;
+ PL_sv_root = Nullsv;
+ PL_sv_arenaroot = Nullsv;
+
+ PL_debug = proto_perl->Idebug;
+
+ /* create SV map for pointer relocation */
+ PL_ptr_table = ptr_table_new();
+
+ /* initialize these special pointers as early as possible */
+ SvANY(&PL_sv_undef) = NULL;
+ SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
+
+#ifdef PERL_OBJECT
+ SvUPGRADE(&PL_sv_no, SVt_PVNV);
+#else
+ SvANY(&PL_sv_no) = new_XPVNV();
+#endif
+ SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+ SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0);
+ SvCUR(&PL_sv_no) = 0;
+ SvLEN(&PL_sv_no) = 1;
+ SvNVX(&PL_sv_no) = 0;
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
+
+#ifdef PERL_OBJECT
+ SvUPGRADE(&PL_sv_yes, SVt_PVNV);
+#else
+ SvANY(&PL_sv_yes) = new_XPVNV();
+#endif
+ SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+ SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1);
+ SvCUR(&PL_sv_yes) = 1;
+ SvLEN(&PL_sv_yes) = 2;
+ SvNVX(&PL_sv_yes) = 1;
+ ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
+
+ /* create shared string table */
+ PL_strtab = newHV();
+ HvSHAREKEYS_off(PL_strtab);
+ hv_ksplit(PL_strtab, 512);
+ ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
+
+ PL_compiling = proto_perl->Icompiling;
+ PL_compiling.cop_stashpv = SAVEPV(PL_compiling.cop_stashpv);
+ PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file);
+ ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
+ if (!specialWARN(PL_compiling.cop_warnings))
+ PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
+
+ /* pseudo environmental stuff */
+ PL_origargc = proto_perl->Iorigargc;
+ i = PL_origargc;
+ New(0, PL_origargv, i+1, char*);
+ PL_origargv[i] = '\0';
+ while (i-- > 0) {
+ PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
+ }
+ PL_envgv = gv_dup(proto_perl->Ienvgv);
+ PL_incgv = gv_dup(proto_perl->Iincgv);
+ PL_hintgv = gv_dup(proto_perl->Ihintgv);
+ PL_origfilename = SAVEPV(proto_perl->Iorigfilename);
+ PL_diehook = sv_dup_inc(proto_perl->Idiehook);
+ PL_warnhook = sv_dup_inc(proto_perl->Iwarnhook);
+
+ /* switches */
+ PL_minus_c = proto_perl->Iminus_c;
+ Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+ PL_localpatches = proto_perl->Ilocalpatches;
+ PL_splitstr = proto_perl->Isplitstr;
+ PL_preprocess = proto_perl->Ipreprocess;
+ PL_minus_n = proto_perl->Iminus_n;
+ PL_minus_p = proto_perl->Iminus_p;
+ PL_minus_l = proto_perl->Iminus_l;
+ PL_minus_a = proto_perl->Iminus_a;
+ PL_minus_F = proto_perl->Iminus_F;
+ PL_doswitches = proto_perl->Idoswitches;
+ PL_dowarn = proto_perl->Idowarn;
+ PL_doextract = proto_perl->Idoextract;
+ PL_sawampersand = proto_perl->Isawampersand;
+ PL_unsafe = proto_perl->Iunsafe;
+ PL_inplace = SAVEPV(proto_perl->Iinplace);
+ PL_e_script = sv_dup_inc(proto_perl->Ie_script);
+ PL_perldb = proto_perl->Iperldb;
+ PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
+
+ /* magical thingies */
+ /* XXX time(&PL_basetime) when asked for? */
+ PL_basetime = proto_perl->Ibasetime;
+ PL_formfeed = sv_dup(proto_perl->Iformfeed);
+
+ PL_maxsysfd = proto_perl->Imaxsysfd;
+ PL_multiline = proto_perl->Imultiline;
+ PL_statusvalue = proto_perl->Istatusvalue;
+#ifdef VMS
+ PL_statusvalue_vms = proto_perl->Istatusvalue_vms;
+#endif
+
+ /* shortcuts to various I/O objects */
+ PL_stdingv = gv_dup(proto_perl->Istdingv);
+ PL_stderrgv = gv_dup(proto_perl->Istderrgv);
+ PL_defgv = gv_dup(proto_perl->Idefgv);
+ PL_argvgv = gv_dup(proto_perl->Iargvgv);
+ PL_argvoutgv = gv_dup(proto_perl->Iargvoutgv);
+ PL_argvout_stack = av_dup(proto_perl->Iargvout_stack);
+
+ /* shortcuts to regexp stuff */
+ PL_replgv = gv_dup(proto_perl->Ireplgv);
+
+ /* shortcuts to misc objects */
+ PL_errgv = gv_dup(proto_perl->Ierrgv);
+
+ /* shortcuts to debugging objects */
+ PL_DBgv = gv_dup(proto_perl->IDBgv);
+ PL_DBline = gv_dup(proto_perl->IDBline);
+ PL_DBsub = gv_dup(proto_perl->IDBsub);
+ PL_DBsingle = sv_dup(proto_perl->IDBsingle);
+ PL_DBtrace = sv_dup(proto_perl->IDBtrace);
+ PL_DBsignal = sv_dup(proto_perl->IDBsignal);
+ PL_lineary = av_dup(proto_perl->Ilineary);
+ PL_dbargs = av_dup(proto_perl->Idbargs);
+
+ /* symbol tables */
+ PL_defstash = hv_dup_inc(proto_perl->Tdefstash);
+ PL_curstash = hv_dup(proto_perl->Tcurstash);
+ PL_debstash = hv_dup(proto_perl->Idebstash);
+ PL_globalstash = hv_dup(proto_perl->Iglobalstash);
+ PL_curstname = sv_dup_inc(proto_perl->Icurstname);
+
+ PL_beginav = av_dup_inc(proto_perl->Ibeginav);
+ PL_endav = av_dup_inc(proto_perl->Iendav);
+ PL_stopav = av_dup_inc(proto_perl->Istopav);
+ PL_initav = av_dup_inc(proto_perl->Iinitav);
+
+ PL_sub_generation = proto_perl->Isub_generation;
+
+ /* funky return mechanisms */
+ PL_forkprocess = proto_perl->Iforkprocess;
+
+ /* subprocess state */
+ PL_fdpid = av_dup_inc(proto_perl->Ifdpid);
+
+ /* internal state */
+ PL_tainting = proto_perl->Itainting;
+ PL_maxo = proto_perl->Imaxo;
+ if (proto_perl->Iop_mask)
+ PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo);
+ else
+ PL_op_mask = Nullch;
+
+ /* current interpreter roots */
+ PL_main_cv = cv_dup_inc(proto_perl->Imain_cv);
+ PL_main_root = OpREFCNT_inc(proto_perl->Imain_root);
+ PL_main_start = proto_perl->Imain_start;
+ PL_eval_root = OpREFCNT_inc(proto_perl->Ieval_root);
+ PL_eval_start = proto_perl->Ieval_start;
+
+ /* runtime control stuff */
+ PL_curcopdb = (COP*)any_dup(proto_perl->Icurcopdb, proto_perl);
+ PL_copline = proto_perl->Icopline;
+
+ PL_filemode = proto_perl->Ifilemode;
+ PL_lastfd = proto_perl->Ilastfd;
+ PL_oldname = proto_perl->Ioldname; /* XXX not quite right */
+ PL_Argv = NULL;
+ PL_Cmd = Nullch;
+ PL_gensym = proto_perl->Igensym;
+ PL_preambled = proto_perl->Ipreambled;
+ PL_preambleav = av_dup_inc(proto_perl->Ipreambleav);
+ PL_laststatval = proto_perl->Ilaststatval;
+ PL_laststype = proto_perl->Ilaststype;
+ PL_mess_sv = Nullsv;
+
+ PL_orslen = proto_perl->Iorslen;
+ PL_ors = SAVEPVN(proto_perl->Iors, PL_orslen);
+ PL_ofmt = SAVEPV(proto_perl->Iofmt);
+
+ /* interpreter atexit processing */
+ PL_exitlistlen = proto_perl->Iexitlistlen;
+ if (PL_exitlistlen) {
+ New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+ Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+ }
+ else
+ PL_exitlist = (PerlExitListEntry*)NULL;
+ PL_modglobal = hv_dup_inc(proto_perl->Imodglobal);
+
+ PL_profiledata = NULL;
+ PL_rsfp = fp_dup(proto_perl->Irsfp, '<');
+ /* PL_rsfp_filters entries have fake IoDIRP() */
+ PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters);
+
+ PL_compcv = cv_dup(proto_perl->Icompcv);
+ PL_comppad = av_dup(proto_perl->Icomppad);
+ PL_comppad_name = av_dup(proto_perl->Icomppad_name);
+ PL_comppad_name_fill = proto_perl->Icomppad_name_fill;
+ PL_comppad_name_floor = proto_perl->Icomppad_name_floor;
+ PL_curpad = (SV**)ptr_table_fetch(PL_ptr_table,
+ proto_perl->Tcurpad);
+
+#ifdef HAVE_INTERP_INTERN
+ sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
+#endif
+
+ /* more statics moved here */
+ PL_generation = proto_perl->Igeneration;
+ PL_DBcv = cv_dup(proto_perl->IDBcv);
+ PL_archpat_auto = SAVEPV(proto_perl->Iarchpat_auto);
+
+ PL_in_clean_objs = proto_perl->Iin_clean_objs;
+ PL_in_clean_all = proto_perl->Iin_clean_all;
+
+ PL_uid = proto_perl->Iuid;
+ PL_euid = proto_perl->Ieuid;
+ PL_gid = proto_perl->Igid;
+ PL_egid = proto_perl->Iegid;
+ PL_nomemok = proto_perl->Inomemok;
+ PL_an = proto_perl->Ian;
+ PL_cop_seqmax = proto_perl->Icop_seqmax;
+ PL_op_seqmax = proto_perl->Iop_seqmax;
+ PL_evalseq = proto_perl->Ievalseq;
+ PL_origenviron = proto_perl->Iorigenviron; /* XXX not quite right */
+ PL_origalen = proto_perl->Iorigalen;
+ PL_pidstatus = newHV(); /* XXX flag for cloning? */
+ PL_osname = SAVEPV(proto_perl->Iosname);
+ PL_sh_path = SAVEPV(proto_perl->Ish_path);
+ PL_sighandlerp = proto_perl->Isighandlerp;
+
+
+ PL_runops = proto_perl->Irunops;
+
+ Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
+
+#ifdef CSH
+ PL_cshlen = proto_perl->Icshlen;
+ PL_cshname = SAVEPVN(proto_perl->Icshname, PL_cshlen);
+#endif
+
+ PL_lex_state = proto_perl->Ilex_state;
+ PL_lex_defer = proto_perl->Ilex_defer;
+ PL_lex_expect = proto_perl->Ilex_expect;
+ PL_lex_formbrack = proto_perl->Ilex_formbrack;
+ PL_lex_dojoin = proto_perl->Ilex_dojoin;
+ PL_lex_starts = proto_perl->Ilex_starts;
+ PL_lex_stuff = sv_dup_inc(proto_perl->Ilex_stuff);
+ PL_lex_repl = sv_dup_inc(proto_perl->Ilex_repl);
+ PL_lex_op = proto_perl->Ilex_op;
+ PL_lex_inpat = proto_perl->Ilex_inpat;
+ PL_lex_inwhat = proto_perl->Ilex_inwhat;
+ PL_lex_brackets = proto_perl->Ilex_brackets;
+ i = (PL_lex_brackets < 120 ? 120 : PL_lex_brackets);
+ PL_lex_brackstack = SAVEPVN(proto_perl->Ilex_brackstack,i);
+ PL_lex_casemods = proto_perl->Ilex_casemods;
+ i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
+ PL_lex_casestack = SAVEPVN(proto_perl->Ilex_casestack,i);
+
+ Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
+ Copy(proto_perl->Inexttype, PL_nexttype, 5, I32);
+ PL_nexttoke = proto_perl->Inexttoke;
+
+ PL_linestr = sv_dup_inc(proto_perl->Ilinestr);
+ i = proto_perl->Ibufptr - SvPVX(proto_perl->Ilinestr);
+ PL_bufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ioldbufptr - SvPVX(proto_perl->Ilinestr);
+ PL_oldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ioldoldbufptr - SvPVX(proto_perl->Ilinestr);
+ PL_oldoldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr);
+ PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_pending_ident = proto_perl->Ipending_ident;
+ PL_sublex_info = proto_perl->Isublex_info; /* XXX not quite right */
+
+ PL_expect = proto_perl->Iexpect;
+
+ PL_multi_start = proto_perl->Imulti_start;
+ PL_multi_end = proto_perl->Imulti_end;
+ PL_multi_open = proto_perl->Imulti_open;
+ PL_multi_close = proto_perl->Imulti_close;
+
+ PL_error_count = proto_perl->Ierror_count;
+ PL_subline = proto_perl->Isubline;
+ PL_subname = sv_dup_inc(proto_perl->Isubname);
+
+ 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;
+
+ i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr);
+ PL_last_uni = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ilast_lop - SvPVX(proto_perl->Ilinestr);
+ PL_last_lop = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_last_lop_op = proto_perl->Ilast_lop_op;
+ PL_in_my = proto_perl->Iin_my;
+ PL_in_my_stash = hv_dup(proto_perl->Iin_my_stash);
+#ifdef FCRYPT
+ PL_cryptseen = proto_perl->Icryptseen;
+#endif
+
+ PL_hints = proto_perl->Ihints;
+
+ PL_amagic_generation = proto_perl->Iamagic_generation;
+
+#ifdef USE_LOCALE_COLLATE
+ PL_collation_ix = proto_perl->Icollation_ix;
+ PL_collation_name = SAVEPV(proto_perl->Icollation_name);
+ PL_collation_standard = proto_perl->Icollation_standard;
+ PL_collxfrm_base = proto_perl->Icollxfrm_base;
+ PL_collxfrm_mult = proto_perl->Icollxfrm_mult;
+#endif /* USE_LOCALE_COLLATE */
+
+#ifdef USE_LOCALE_NUMERIC
+ PL_numeric_name = SAVEPV(proto_perl->Inumeric_name);
+ PL_numeric_standard = proto_perl->Inumeric_standard;
+ PL_numeric_local = proto_perl->Inumeric_local;
+ PL_numeric_radix = proto_perl->Inumeric_radix;
+#endif /* !USE_LOCALE_NUMERIC */
+
+ /* utf8 character classes */
+ PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum);
+ PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc);
+ PL_utf8_ascii = sv_dup_inc(proto_perl->Iutf8_ascii);
+ PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha);
+ PL_utf8_space = sv_dup_inc(proto_perl->Iutf8_space);
+ PL_utf8_cntrl = sv_dup_inc(proto_perl->Iutf8_cntrl);
+ PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph);
+ PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit);
+ PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper);
+ PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower);
+ PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print);
+ PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct);
+ PL_utf8_xdigit = sv_dup_inc(proto_perl->Iutf8_xdigit);
+ PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark);
+ PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper);
+ PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle);
+ PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower);
+
+ /* swatch cache */
+ PL_last_swash_hv = Nullhv; /* reinits on demand */
+ PL_last_swash_klen = 0;
+ PL_last_swash_key[0]= '\0';
+ PL_last_swash_tmps = (U8*)NULL;
+ PL_last_swash_slen = 0;
+
+ /* perly.c globals */
+ PL_yydebug = proto_perl->Iyydebug;
+ PL_yynerrs = proto_perl->Iyynerrs;
+ PL_yyerrflag = proto_perl->Iyyerrflag;
+ PL_yychar = proto_perl->Iyychar;
+ PL_yyval = proto_perl->Iyyval;
+ PL_yylval = proto_perl->Iyylval;
+
+ PL_glob_index = proto_perl->Iglob_index;
+ PL_srand_called = proto_perl->Isrand_called;
+ PL_uudmap['M'] = 0; /* reinits on demand */
+ PL_bitcount = Nullch; /* reinits on demand */
+
+ if (proto_perl->Ipsig_ptr) {
+ int sig_num[] = { SIG_NUM };
+ Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ for (i = 1; PL_sig_name[i]; i++) {
+ PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
+ PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]);
+ }
+ }
+ else {
+ PL_psig_ptr = (SV**)NULL;
+ PL_psig_name = (SV**)NULL;
+ }
+
+ /* thrdvar.h stuff */
+
+ if (flags & 1) {
+ /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
+ PL_tmps_ix = proto_perl->Ttmps_ix;
+ PL_tmps_max = proto_perl->Ttmps_max;
+ PL_tmps_floor = proto_perl->Ttmps_floor;
+ Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+ i = 0;
+ while (i <= PL_tmps_ix) {
+ PL_tmps_stack[i] = sv_dup_inc(proto_perl->Ttmps_stack[i]);
+ ++i;
+ }
+
+ /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
+ i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+ Newz(54, PL_markstack, i, I32);
+ PL_markstack_max = PL_markstack + (proto_perl->Tmarkstack_max
+ - proto_perl->Tmarkstack);
+ PL_markstack_ptr = PL_markstack + (proto_perl->Tmarkstack_ptr
+ - proto_perl->Tmarkstack);
+ Copy(proto_perl->Tmarkstack, PL_markstack,
+ PL_markstack_ptr - PL_markstack + 1, I32);
+
+ /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
+ * NOTE: unlike the others! */
+ PL_scopestack_ix = proto_perl->Tscopestack_ix;
+ PL_scopestack_max = proto_perl->Tscopestack_max;
+ Newz(54, PL_scopestack, PL_scopestack_max, I32);
+ Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+
+ /* next push_return() sets PL_retstack[PL_retstack_ix]
+ * NOTE: unlike the others! */
+ PL_retstack_ix = proto_perl->Tretstack_ix;
+ PL_retstack_max = proto_perl->Tretstack_max;
+ Newz(54, PL_retstack, PL_retstack_max, OP*);
+ Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+
+ /* NOTE: si_dup() looks at PL_markstack */
+ PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo);
+
+ /* PL_curstack = PL_curstackinfo->si_stack; */
+ PL_curstack = av_dup(proto_perl->Tcurstack);
+ PL_mainstack = av_dup(proto_perl->Tmainstack);
+
+ /* next PUSHs() etc. set *(PL_stack_sp+1) */
+ PL_stack_base = AvARRAY(PL_curstack);
+ PL_stack_sp = PL_stack_base + (proto_perl->Tstack_sp
+ - proto_perl->Tstack_base);
+ PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
+
+ /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
+ * NOTE: unlike the others! */
+ PL_savestack_ix = proto_perl->Tsavestack_ix;
+ PL_savestack_max = proto_perl->Tsavestack_max;
+ /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+ PL_savestack = ss_dup(proto_perl);
+ }
+ else {
+ init_stacks();
+ }
+
+ PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
+ PL_top_env = &PL_start_env;
+
+ PL_op = proto_perl->Top;
+
+ PL_Sv = Nullsv;
+ PL_Xpv = (XPV*)NULL;
+ PL_na = proto_perl->Tna;
+
+ PL_statbuf = proto_perl->Tstatbuf;
+ PL_statcache = proto_perl->Tstatcache;
+ PL_statgv = gv_dup(proto_perl->Tstatgv);
+ PL_statname = sv_dup_inc(proto_perl->Tstatname);
+#ifdef HAS_TIMES
+ PL_timesbuf = proto_perl->Ttimesbuf;
+#endif
+
+ PL_tainted = proto_perl->Ttainted;
+ PL_curpm = proto_perl->Tcurpm; /* XXX No PMOP ref count */
+ PL_nrs = sv_dup_inc(proto_perl->Tnrs);
+ PL_rs = sv_dup_inc(proto_perl->Trs);
+ PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv);
+ PL_ofslen = proto_perl->Tofslen;
+ PL_ofs = SAVEPVN(proto_perl->Tofs, PL_ofslen);
+ PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv);
+ PL_chopset = proto_perl->Tchopset; /* XXX never deallocated */
+ PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget);
+ PL_bodytarget = sv_dup_inc(proto_perl->Tbodytarget);
+ PL_formtarget = sv_dup(proto_perl->Tformtarget);
+
+ PL_restartop = proto_perl->Trestartop;
+ PL_in_eval = proto_perl->Tin_eval;
+ PL_delaymagic = proto_perl->Tdelaymagic;
+ PL_dirty = proto_perl->Tdirty;
+ PL_localizing = proto_perl->Tlocalizing;
+
+ PL_protect = proto_perl->Tprotect;
+ PL_errors = sv_dup_inc(proto_perl->Terrors);
+ PL_av_fetch_sv = Nullsv;
+ PL_hv_fetch_sv = Nullsv;
+ Zero(&PL_hv_fetch_ent_mh, 1, HE); /* XXX */
+ PL_modcount = proto_perl->Tmodcount;
+ PL_lastgotoprobe = Nullop;
+ PL_dumpindent = proto_perl->Tdumpindent;
+
+ PL_sortcop = (OP*)any_dup(proto_perl->Tsortcop, proto_perl);
+ PL_sortstash = hv_dup(proto_perl->Tsortstash);
+ PL_firstgv = gv_dup(proto_perl->Tfirstgv);
+ PL_secondgv = gv_dup(proto_perl->Tsecondgv);
+ PL_sortcxix = proto_perl->Tsortcxix;
+ PL_efloatbuf = Nullch; /* reinits on demand */
+ PL_efloatsize = 0; /* reinits on demand */
+
+ /* regex stuff */
+
+ PL_screamfirst = NULL;
+ PL_screamnext = NULL;
+ PL_maxscream = -1; /* reinits on demand */
+ PL_lastscream = Nullsv;
+
+ PL_watchaddr = NULL;
+ PL_watchok = Nullch;
+
+ PL_regdummy = proto_perl->Tregdummy;
+ PL_regcomp_parse = Nullch;
+ PL_regxend = Nullch;
+ PL_regcode = (regnode*)NULL;
+ PL_regnaughty = 0;
+ PL_regsawback = 0;
+ PL_regprecomp = Nullch;
+ PL_regnpar = 0;
+ PL_regsize = 0;
+ PL_regflags = 0;
+ PL_regseen = 0;
+ PL_seen_zerolen = 0;
+ PL_seen_evals = 0;
+ PL_regcomp_rx = (regexp*)NULL;
+ PL_extralen = 0;
+ PL_colorset = 0; /* reinits PL_colors[] */
+ /*PL_colors[6] = {0,0,0,0,0,0};*/
+ PL_reg_whilem_seen = 0;
+ PL_reginput = Nullch;
+ PL_regbol = Nullch;
+ PL_regeol = Nullch;
+ PL_regstartp = (I32*)NULL;
+ PL_regendp = (I32*)NULL;
+ PL_reglastparen = (U32*)NULL;
+ PL_regtill = Nullch;
+ PL_regprev = '\n';
+ PL_reg_start_tmp = (char**)NULL;
+ PL_reg_start_tmpl = 0;
+ PL_regdata = (struct reg_data*)NULL;
+ PL_bostr = Nullch;
+ PL_reg_flags = 0;
+ PL_reg_eval_set = 0;
+ PL_regnarrate = 0;
+ PL_regprogram = (regnode*)NULL;
+ PL_regindent = 0;
+ PL_regcc = (CURCUR*)NULL;
+ PL_reg_call_cc = (struct re_cc_state*)NULL;
+ PL_reg_re = (regexp*)NULL;
+ PL_reg_ganch = Nullch;
+ PL_reg_sv = Nullsv;
+ PL_reg_magic = (MAGIC*)NULL;
+ PL_reg_oldpos = 0;
+ PL_reg_oldcurpm = (PMOP*)NULL;
+ PL_reg_curpm = (PMOP*)NULL;
+ PL_reg_oldsaved = Nullch;
+ PL_reg_oldsavedlen = 0;
+ PL_reg_maxiter = 0;
+ PL_reg_leftiter = 0;
+ PL_reg_poscache = Nullch;
+ PL_reg_poscache_size= 0;
+
+ /* RE engine - function pointers */
+ PL_regcompp = proto_perl->Tregcompp;
+ PL_regexecp = proto_perl->Tregexecp;
+ PL_regint_start = proto_perl->Tregint_start;
+ PL_regint_string = proto_perl->Tregint_string;
+ PL_regfree = proto_perl->Tregfree;
+
+ PL_reginterp_cnt = 0;
+ PL_reg_starttry = 0;
+
+#ifdef PERL_OBJECT
+ return (PerlInterpreter*)pPerl;
+#else
+ return my_perl;
+#endif
+}
+
+#else /* !USE_ITHREADS */
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
+#endif /* USE_ITHREADS */
+
static void
do_report_used(pTHXo_ SV *sv)
{
static void
do_clean_all(pTHXo_ SV *sv)
{
- DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );)
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) );)
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
}
U8 xbm_rare; /* rarest character in string */
};
-/* This structure much match XPVCV */
+/* This structure much match XPVCV in cv.h */
typedef U16 cv_flags_t;
void (*xcv_xsub)(pTHXo_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
- GV * xcv_filegv;
- long xcv_depth; /* >= 2 indicates recursive call */
+ char * xcv_file;
+ long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
#ifdef USE_THREADS
char xio_flags;
};
-#define IOf_ARGV 1 /* this fp iterates over ARGV */
-#define IOf_START 2 /* check for null ARGV and substitute '-' */
-#define IOf_FLUSH 4 /* this fp wants a flush after write op */
-#define IOf_DIDTOP 8 /* just did top of form */
-#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
-#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
+#define IOf_ARGV 1 /* this fp iterates over ARGV */
+#define IOf_START 2 /* check for null ARGV and substitute '-' */
+#define IOf_FLUSH 4 /* this fp wants a flush after write op */
+#define IOf_DIDTOP 8 /* just did top of form */
+#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
+#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
+#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) */
/* The following macros define implementation-independent predicates on SVs. */
$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
$^O eq 'os2' or $^O eq 'mint');
+if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
+ $Is_Dosish = '' if Win32::FsType() eq 'NTFS';
+}
+
print "1..28\n";
$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
{print "ok 5\n";}
else {print "not ok 5\n";}
-if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+$newmode = $^O eq 'MSWin32' ? 0444 : 0777;
+if ((chmod $newmode,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
if ($Is_Dosish) {print "ok 7 # skipped: no link\n";}
-elsif (($mode & 0777) == 0777) {print "ok 7\n";}
+elsif (($mode & 0777) == $newmode) {print "ok 7\n";}
else {print "not ok 7\n";}
+$newmode = 0700;
+if ($^O eq 'MSWin32') {
+ chmod 0444, 'x';
+ $newmode = 0666;
+}
+
if ($Is_Dosish) {print "ok 8 # skipped: no link\n";}
-elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";}
+elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";}
else {print "not ok 8\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('c');
if ($Is_Dosish) {print "ok 9 # skipped: no link\n";}
-elsif (($mode & 0777) == 0700) {print "ok 9\n";}
+elsif (($mode & 0777) == $newmode) {print "ok 9\n";}
else {print "not ok 9\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('x');
if ($Is_Dosish) {print "ok 10 # skipped: no link\n";}
-elsif (($mode & 0777) == 0700) {print "ok 10\n";}
+elsif (($mode & 0777) == $newmode) {print "ok 10\n";}
else {print "not ok 10\n";}
if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; }
--- /dev/null
+#!./perl
+
+print "1..5\n";
+
+my $j = 1;
+for $i ( 1,2,5,4,3 ) {
+ $file = mkfiles($i);
+ open(FH, "> $file") || die "can't create $file: $!";
+ print FH "not ok " . $j++ . "\n";
+ close(FH) || die "Can't close $file: $!";
+}
+
+
+{
+ local *ARGV;
+ local $^I = '.bak';
+ local $_;
+ @ARGV = mkfiles(1..3);
+ $n = 0;
+ while (<>) {
+ print STDOUT "# initial \@ARGV: [@ARGV]\n";
+ if ($n++ == 2) {
+ other();
+ }
+ show();
+ }
+}
+
+$^I = undef;
+@ARGV = mkfiles(1..3);
+$n = 0;
+while (<>) {
+ print STDOUT "#final \@ARGV: [@ARGV]\n";
+ if ($n++ == 2) {
+ other();
+ }
+ show();
+}
+
+sub show {
+ #warn "$ARGV: $_";
+ s/^not //;
+ print;
+}
+
+sub other {
+ print STDOUT "# Calling other\n";
+ local *ARGV;
+ local *ARGVOUT;
+ local $_;
+ @ARGV = mkfiles(5, 4);
+ while (<>) {
+ print STDOUT "# inner \@ARGV: [@ARGV]\n";
+ show();
+ }
+}
+
+sub mkfiles {
+ my @files = map { "scratch$_" } @_;
+ return wantarray ? @files : $files[-1];
+}
+
+END { unlink map { ($_, "$_.bak") } mkfiles(1..5) }
$^W = 1;
$Is_VMS = $^O eq 'VMS';
-print "1..32\n";
+print "1..64\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
# my $file tests
+# 1..9
{
-unlink("afile") if -f "afile";
-print "$!\nnot " unless open(my $f,"+>afile");
-print "ok 1\n";
-binmode $f;
-print "not " unless -f "afile";
-print "ok 2\n";
-print "not " unless print $f "SomeData\n";
-print "ok 3\n";
-print "not " unless tell($f) == 9;
-print "ok 4\n";
-print "not " unless seek($f,0,0);
-print "ok 5\n";
-$b = <$f>;
-print "not " unless $b eq "SomeData\n";
-print "ok 6\n";
-print "not " unless -f $f;
-print "ok 7\n";
-eval { die "Message" };
-# warn $@;
-print "not " unless $@ =~ /<\$f> line 1/;
-print "ok 8\n";
-print "not " unless close($f);
-print "ok 9\n";
-unlink("afile");
+ unlink("afile") if -f "afile";
+ print "$!\nnot " unless open(my $f,"+>afile");
+ ok;
+ binmode $f;
+ print "not " unless -f "afile";
+ ok;
+ print "not " unless print $f "SomeData\n";
+ ok;
+ print "not " unless tell($f) == 9;
+ ok;
+ print "not " unless seek($f,0,0);
+ ok;
+ $b = <$f>;
+ print "not " unless $b eq "SomeData\n";
+ ok;
+ print "not " unless -f $f;
+ ok;
+ eval { die "Message" };
+ # warn $@;
+ print "not " unless $@ =~ /<\$f> line 1/;
+ ok;
+ print "not " unless close($f);
+ ok;
+ unlink("afile");
}
+
+# 10..12
{
-print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
-print "ok 10\n";
-print $f "a row\n";
-print "not " unless close($f);
-print "ok 11\n";
-print "not " unless -s 'afile' < 10;
-print "ok 12\n";
+ print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
+ ok;
+ print $f "a row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' < 10;
+ ok;
}
+
+# 13..15
{
-print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
-print "ok 13\n";
-print $f "a row\n";
-print "not " unless close($f);
-print "ok 14\n";
-print "not " unless -s 'afile' > 10;
-print "ok 15\n";
+ print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
+ ok;
+ print $f "a row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' > 10;
+ ok;
}
+
+# 16..18
{
-print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
-print "ok 16\n";
-@rows = <$f>;
-print "not " unless @rows == 2;
-print "ok 17\n";
-print "not " unless close($f);
-print "ok 18\n";
+ print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ print "not " unless close($f);
+ ok;
}
+
+# 19..23
{
-print "not " unless -s 'afile' < 20;
-print "ok 19\n";
-print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
-print "ok 20\n";
-@rows = <$f>;
-print "not " unless @rows == 2;
-print "ok 21\n";
-seek $f, 0, 1;
-print $f "yet another row\n";
-print "not " unless close($f);
-print "ok 22\n";
-print "not " unless -s 'afile' > 20;
-print "ok 23\n";
-
-unlink("afile");
-}
-if ($Is_VMS) { for (24..46) { print "ok $_ # skipped: not Unix fork\n"; } }
+ print "not " unless -s 'afile' < 20;
+ ok;
+ print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ seek $f, 0, 1;
+ print $f "yet another row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' > 20;
+ ok;
+
+ unlink("afile");
+}
+
+# 24..26
+if ($Is_VMS) {
+ for (24..26) { print "ok $_ # skipped: not Unix fork\n"; }
+}
else {
-print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
-./perl -e "print qq(a row\n); print qq(another row\n)"
+ print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
+ ./perl -e "print qq(a row\n); print qq(another row\n)"
EOC
-print "ok 24\n";
-@rows = <$f>;
-print "not " unless @rows == 2;
-print "ok 25\n";
-print "not " unless close($f);
-print "ok 26\n";
-}
-if ($Is_VMS) { for (27..30) { print "OK $_ # skipped: not Unix fork\n"; } }
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ print "not " unless close($f);
+ ok;
+}
+
+# 27..30
+if ($Is_VMS) {
+ for (27..30) { print "ok $_ # skipped: not Unix fork\n"; }
+}
else {
-print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
-./perl -pe "s/^not //"
+ print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
+ ./perl -pe "s/^not //"
EOC
-print "ok 27\n";
-@rows = <$f>;
-print $f "not ok 28\n";
-print $f "not ok 29\n";
-print "#\nnot " unless close($f);
-sleep 1;
-print "ok 30\n";
+ ok;
+ @rows = <$f>;
+ print $f "not ok $test\n"; $test++;
+ print $f "not ok $test\n"; $test++;
+ print "#\nnot " unless close($f);
+ sleep 1;
+ ok;
}
+# 31..32
eval <<'EOE' and print "not ";
open my $f, '<&', 'afile';
1;
EOE
-print "ok 31\n";
+ok;
+$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
+ok;
+
+# local $file tests
+
+# 33..41
+{
+ unlink("afile") if -f "afile";
+ print "$!\nnot " unless open(local $f,"+>afile");
+ ok;
+ binmode $f;
+ print "not " unless -f "afile";
+ ok;
+ print "not " unless print $f "SomeData\n";
+ ok;
+ print "not " unless tell($f) == 9;
+ ok;
+ print "not " unless seek($f,0,0);
+ ok;
+ $b = <$f>;
+ print "not " unless $b eq "SomeData\n";
+ ok;
+ print "not " unless -f $f;
+ ok;
+ eval { die "Message" };
+ # warn $@;
+ print "not " unless $@ =~ /<\$f> line 1/;
+ ok;
+ print "not " unless close($f);
+ ok;
+ unlink("afile");
+}
+
+# 42..44
+{
+ print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
+ ok;
+ print $f "a row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' < 10;
+ ok;
+}
+
+# 45..47
+{
+ print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
+ ok;
+ print $f "a row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' > 10;
+ ok;
+}
+
+# 48..50
+{
+ print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ print "not " unless close($f);
+ ok;
+}
+
+# 51..55
+{
+ print "not " unless -s 'afile' < 20;
+ ok;
+ print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ seek $f, 0, 1;
+ print $f "yet another row\n";
+ print "not " unless close($f);
+ ok;
+ print "not " unless -s 'afile' > 20;
+ ok;
+
+ unlink("afile");
+}
+
+# 56..58
+if ($Is_VMS) {
+ for (56..58) { print "ok $_ # skipped: not Unix fork\n"; }
+}
+else {
+ print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
+ ./perl -e "print qq(a row\n); print qq(another row\n)"
+EOC
+ ok;
+ @rows = <$f>;
+ print "not " unless @rows == 2;
+ ok;
+ print "not " unless close($f);
+ ok;
+}
+
+# 59..62
+if ($Is_VMS) {
+ for (59..62) { print "ok $_ # skipped: not Unix fork\n"; }
+}
+else {
+ print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
+ ./perl -pe "s/^not //"
+EOC
+ ok;
+ @rows = <$f>;
+ print $f "not ok $test\n"; $test++;
+ print $f "not ok $test\n"; $test++;
+ print "#\nnot " unless close($f);
+ sleep 1;
+ ok;
+}
+
+# 63..64
+eval <<'EOE' and print "not ";
+open local $f, '<&', 'afile';
+1;
+EOE
+ok;
$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
-print "ok 32\n";
+ok;
#!./perl
-# $RCSfile: print.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:32 $
-
-print "1..16\n";
+print "1..18\n";
$foo = 'STDOUT';
print $foo "ok 1\n";
@x = ("ok","12\nok","13\nok");
@y = ("15\nok","16");
print @x,"14\nok",@y;
+{
+ local $\ = "ok 17\n# null =>[\000]\nok 18\n";
+ print "";
+}
print "not " unless "Here\N{EXCLAMATION MARK}?" eq 'Here!?';
print "ok 1\n";
-print "# \$res=$res \$\@='$@'\nnot "
- if $res = eval <<'EOE'
+{
+ no utf8; # UTEST can switch it on
+
+ print "# \$res=$res \$\@='$@'\nnot "
+ if $res = eval <<'EOE'
use charnames ":full";
"Here: \N{CYRILLIC SMALL LETTER BE}!";
1
EOE
- or $@ !~ /above 0xFF/;
-print "ok 2\n";
-# print "# \$res=$res \$\@='$@'\n";
+ or $@ !~ /above 0xFF/;
+ print "ok 2\n";
+ # print "# \$res=$res \$\@='$@'\n";
-print "# \$res=$res \$\@='$@'\nnot "
- if $res = eval <<'EOE'
+ print "# \$res=$res \$\@='$@'\nnot "
+ if $res = eval <<'EOE'
use charnames 'cyrillic';
"Here: \N{Be}!";
1
EOE
- or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
-print "ok 3\n";
+ or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
+ print "ok 3\n";
+}
# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
$encoded_be = "\320\261";
-#!./perl
+####!./perl
+
+
+my %Expect;
+my $symlink_exists = eval { symlink("",""); 1 };
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
}
-print "1..2\n";
+if ( $symlink_exists ) { print "1..59\n"; }
+else { print "1..31\n"; }
use File::Find;
-# hope we will eventually find ourself
find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, ".");
finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, ".");
+
+
+my $case = 2;
+
+END {
+ unlink 'FA/FA_ord','FA/FSL','FA/FAA/FAA_ord',
+ 'FA/FAB/FAB_ord','FA/FAB/FABA/FABA_ord','FB/FB_ord','FB/FBA/FBA_ord';
+ rmdir 'FA/FAA';
+ rmdir 'FA/FAB/FABA';
+ rmdir 'FA/FAB';
+ rmdir 'FA';
+ rmdir 'FB/FBA';
+ rmdir 'FB';
+}
+
+sub Check($) {
+ $case++;
+ if ($_[0]) { print "ok $case\n"; }
+ else { print "not ok $case\n"; }
+}
+
+sub CheckDie($) {
+ $case++;
+ if ($_[0]) { print "ok $case\n"; }
+ else { print "not ok $case\n $!\n"; exit 0; }
+}
+
+sub touch {
+ CheckDie( open(my $T,'>',$_[0]) );
+}
+
+sub MkDir($$) {
+ CheckDie( mkdir($_[0],$_[1]) );
+}
+
+sub wanted {
+ print "# '$_' => 1\n";
+ Check( $Expect{$_} );
+ delete $Expect{$_};
+ $File::Find::prune=1 if $_ eq 'FABA';
+}
+
+MkDir( 'FA',0770 );
+MkDir( 'FB',0770 );
+touch('FB/FB_ord');
+MkDir( 'FB/FBA',0770 );
+touch('FB/FBA/FBA_ord');
+CheckDie( symlink('../FB','FA/FSL') ) if $symlink_exists;
+touch('FA/FA_ord');
+
+MkDir( 'FA/FAA',0770 );
+touch('FA/FAA/FAA_ord');
+MkDir( 'FA/FAB',0770 );
+touch('FA/FAB/FAB_ord');
+MkDir( 'FA/FAB/FABA',0770 );
+touch('FA/FAB/FABA/FABA_ord');
+
+%Expect = ('.' => 1, 'FSL' => 1, 'FA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1,
+ 'FABA' => 1, 'FAA' => 1, 'FAA_ord' => 1);
+delete $Expect{'FSL'} unless $symlink_exists;
+File::Find::find( {wanted => \&wanted, },'FA' );
+Check( scalar(keys %Expect) == 0 );
+
+%Expect=('FA' => 1, 'FA/FSL' => 1, 'FA/FA_ord' => 1, 'FA/FAB' => 1,
+ 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1,
+ 'FA/FAB/FABA/FABA_ord' => 1, 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1);
+delete $Expect{'FA/FSL'} unless $symlink_exists;
+File::Find::find( {wanted => \&wanted, no_chdir => 1},'FA' );
+
+Check( scalar(keys %Expect) == 0 );
+
+if ( $symlink_exists ) {
+ %Expect=('.' => 1, 'FA_ord' => 1, 'FSL' => 1, 'FB_ord' => 1, 'FBA' => 1,
+ 'FBA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, 'FABA' => 1, 'FAA' => 1,
+ 'FAA_ord' => 1);
+
+ File::Find::find( {wanted => \&wanted, follow_fast => 1},'FA' );
+ Check( scalar(keys %Expect) == 0 );
+ %Expect=('FA' => 1, 'FA/FA_ord' => 1, 'FA/FSL' => 1, 'FA/FSL/FB_ord' => 1,
+ 'FA/FSL/FBA' => 1, 'FA/FSL/FBA/FBA_ord' => 1, 'FA/FAB' => 1,
+ 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, 'FA/FAB/FABA/FABA_ord' => 1,
+ 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1);
+ File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'FA' );
+ Check( scalar(keys %Expect) == 0 );
+}
+
+print "# of cases: $case\n";
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ print "1..7\n";
+}
+END {
+ print "not ok 1\n" unless $loaded;
+}
+use File::Glob qw(:glob csh_glob);
+$loaded = 1;
+print "ok 1\n";
+
+# Test the actual use of the case sensitivity tags, via csh_glob()
+import File::Glob ':nocase';
+@a = csh_glob("lib/G*.t"); # At least glob-basic.t glob-case.t glob-global.t
+print "not " unless @a >= 3;
+print "ok 2\n";
+
+# This may fail on systems which are not case-PRESERVING
+import File::Glob ':case';
+@a = csh_glob("lib/G*.t"); # None should be uppercase
+print "not " unless @a == 0;
+print "ok 3\n";
+
+# Test the explicit use of the GLOB_NOCASE flag
+@a = File::Glob::glob("lib/G*.t", GLOB_NOCASE);
+print "not " unless @a >= 3;
+print "ok 4\n";
+
+# Test Win32 backslash nastiness...
+if ($^O ne 'MSWin32') {
+ print "ok 5\nok 6\nok 7\n";
+}
+else {
+ @a = File::Glob::glob("lib\\g*.t");
+ print "not " unless @a >= 3;
+ print "ok 5\n";
+ mkdir "[]", 0;
+ @a = File::Glob::glob("\\[\\]", GLOB_QUOTE);
+ rmdir "[]";
+ print "# returned @a\nnot " unless @a == 1;
+ print "ok 6\n";
+ @a = File::Glob::glob("lib\\*", GLOB_QUOTE);
+ print "not " if @a == 0;
+ print "ok 7\n";
+}
}
}
-use File::Glob 'globally';
+use File::Glob ':globally';
$loaded = 1;
print "ok 1\n";
# how about in a different package, like?
package Foo;
-use File::Glob 'globally';
+use File::Glob ':globally';
@s = ();
while (glob '*/*.t') {
#print "# $_\n";
chdir 't' if -d 't';
unshift @INC, '../lib' if -d '../lib';
}
+ # ``use IO::Socket'' executes too early below in the os2 block
+ if ($^O eq 'dos') {
+ print "1..0 # Skip: no fork\n";
+ }
}
use Config;
my $msgtype = 1;
my $msgtext = "hello";
- msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
+ my $test2bad;
+ my $test5bad;
+ my $test6bad;
+
+ unless (msgsnd($msg,pack("L a*",$msgtype,$msgtext),IPC_NOWAIT)) {
+ print "not ";
+ $test2bad = 1;
+ }
print "ok 2\n";
+ if ($test2bad) {
+ print <<EOM;
+#
+# The failure of the subtest #2 may indicate that the message queue
+# resource limits either of the system or of the testing account
+# have been reached. Error message "Operating would block" is
+# usually indicative of this situation. The error message was now:
+# "$!"
+#
+# You can check the message queues with the 'ipcs' command and
+# you can remove unneeded queues with the 'ipcrm -q id' command.
+# You may also consider configuring your system or account
+# to have more message queue resources.
+#
+# Because of the subtest #2 failing also the substests #5 and #6 will
+# very probably also fail.
+#
+EOM
+ }
my $data;
msgctl($msg,IPC_STAT,$data) or print "not ";
print "ok 4\n";
my $msgbuf;
- msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT) or print "not ";
+ unless (msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT)) {
+ print "not ";
+ $test5bad = 1;
+ }
print "ok 5\n";
+ if ($test5bad && $test2bad) {
+ print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+ }
my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
- print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
+ unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext) {
+ print "not ";
+ $test6bad = 1;
+ }
print "ok 6\n";
+ if ($test6bad && $test2bad) {
+ print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+ }
} else {
for (1..6) {
print "ok $_\n"; # fake it
# If you modify/add tests here, remember to update also t/op/lfs.t.
BEGIN {
- # Don't bother if there are no quads.
- eval { my $q = pack "q", 0 };
- if ($@) {
- print "1..0\n# no 64-bit types\n";
- exit(0);
- }
chdir 't' if -d 't';
unshift @INC, '../lib';
require Config; import Config;
EOM
}
+print "# checking whether we have sparse files...\n";
+
# Known have-nots.
if ($^O eq 'win32' || $^O eq 'vms') {
- print "1..0\n# no sparse files\n";
+ print "1..0\n# no sparse files (because this is $^O) \n";
bye();
}
# Known haves that have problems running this test
# (for example because they do not support sparse files, like UNICOS)
if ($^O eq 'unicos') {
- print "1..0\n# large files known to work but unable to test them here\n";
+ print "1..0\n# large files known to work but unable to test them here ($^O)\n";
bye();
}
-# Then try to deduce whether we have sparse files.
+# Then try heuristically to deduce whether we have sparse files.
# We'll start off by creating a one megabyte file which has
# only three "true" bytes. If we have sparseness, we should
bye();
}
+print "# we seem to have sparse files...\n";
+
# By now we better be sure that we do have sparse files:
# if we are not, the following will hog 5 gigabytes of disk. Ooops.
$ENV{LC_ALL} = "C";
sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
- do { warn "sysopen failed: $!\n"; bye };
-sysseek(BIG, 5_000_000_000, SEEK_SET);
+ do { warn "sysopen 'big' failed: $!\n"; bye };
+my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
+unless (defined $sysseek && $sysseek == 5_000_000_000) {
+ print "1..0\n# seeking past 2GB failed: $! (sysseek returned ",
+ defined $sysseek ? $sysseek : 'undef', ")\n";
+ explain();
+ bye();
+}
# The syswrite will fail if there are are filesize limitations (process or fs).
-my $syswrite = syswrite(BIG, "big") == 3;
-my $close = close BIG if $syswrite;
+my $syswrite = syswrite(BIG, "big");
+print "# syswrite failed: $! (syswrite returned ",
+ defined $syswrite ? $syswrite : 'undef', ")\n"
+ unless defined $syswrite && $syswrite == 3;
+my $close = close BIG;
+print "# close failed: $!\n" unless $close;
unless($syswrite && $close) {
- unless ($syswrite) {
- print "# syswrite failed: $!\n"
- } else {
- print "# close failed: $!\n"
- }
if ($! =~/too large/i) {
print "1..0\n# writing past 2GB failed: process limits?\n";
} elsif ($! =~ /quota/i) {
#!./perl
-print "1..65\n";
+print "1..66\n";
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
sub reify { $_[1] = ++$t; print "@_\n"; }
reify('ok');
reify('ok');
+
+# qw() is no more a runtime split, it's compiletime.
+print "not " unless qw(foo bar snorfle)[2] eq 'snorfle';
+print "ok 66\n";
+
#!./perl
-# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $
+# tests for both real and emulated fork()
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}) {
+ unless ($Config{'d_fork'} || $Config{ccflags} =~ /-DUSE_ITHREADS\b/) {
print "1..0 # Skip: no fork\n";
exit 0;
}
+ $ENV{PERL5LIB} = "../lib";
}
-$| = 1;
-print "1..2\n";
+$|=1;
+
+undef $/;
+@prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+$tmpfile = "forktmp000";
+1 while -f ++$tmpfile;
+END { unlink $tmpfile if $tmpfile; }
+
+$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
+for (@prgs){
+ my $switch;
+ if (s/^\s*(-\w.*)//){
+ $switch = $1;
+ }
+ my($prog,$expected) = split(/\nEXPECT\n/, $_);
+ $expected =~ s/\n+$//;
+ # results can be in any order, so sort 'em
+ my @expected = sort split /\n/, $expected;
+ open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
+ print TEST $prog, "\n";
+ close TEST or die "Cannot close $tmpfile: $!";
+ my $results;
+ if ($^O eq 'MSWin32') {
+ $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
+ }
+ else {
+ $results = `./perl $switch $tmpfile 2>&1`;
+ }
+ $status = $?;
+ $results =~ s/\n+$//;
+ $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
+ $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
+ my @results = sort split /\n/, $results;
+ if ( "@results" ne "@expected" ) {
+ print STDERR "PROG: $switch\n$prog\n";
+ print STDERR "EXPECTED:\n$expected\n";
+ print STDERR "GOT:\n$results\n";
+ print "not ";
+ }
+ print "ok ", ++$i, "\n";
+}
+
+__END__
+$| = 1;
if ($cid = fork) {
- sleep 2;
- if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";}
+ sleep 1;
+ if ($result = (kill 9, $cid)) {
+ print "ok 2\n";
+ }
+ else {
+ print "not ok 2 $result\n";
+ }
+ sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug
}
else {
- $| = 1;
print "ok 1\n";
sleep 10;
}
+EXPECT
+ok 1
+ok 2
+########
+$| = 1;
+sub forkit {
+ print "iteration $i start\n";
+ my $x = fork;
+ if (defined $x) {
+ if ($x) {
+ print "iteration $i parent\n";
+ }
+ else {
+ print "iteration $i child\n";
+ }
+ }
+ else {
+ print "pid $$ failed to fork\n";
+ }
+}
+while ($i++ < 3) { do { forkit(); }; }
+EXPECT
+iteration 1 start
+iteration 1 parent
+iteration 1 child
+iteration 2 start
+iteration 2 parent
+iteration 2 child
+iteration 2 start
+iteration 2 parent
+iteration 2 child
+iteration 3 start
+iteration 3 parent
+iteration 3 child
+iteration 3 start
+iteration 3 parent
+iteration 3 child
+iteration 3 start
+iteration 3 parent
+iteration 3 child
+iteration 3 start
+iteration 3 parent
+iteration 3 child
+########
+$| = 1;
+fork()
+ ? (print("parent\n"),sleep(1))
+ : (print("child\n"),exit) ;
+EXPECT
+parent
+child
+########
+$| = 1;
+fork()
+ ? (print("parent\n"),exit)
+ : (print("child\n"),sleep(1)) ;
+EXPECT
+parent
+child
+########
+$| = 1;
+@a = (1..3);
+for (@a) {
+ if (fork) {
+ print "parent $_\n";
+ $_ = "[$_]";
+ }
+ else {
+ print "child $_\n";
+ $_ = "-$_-";
+ }
+}
+print "@a\n";
+EXPECT
+parent 1
+child 1
+parent 2
+child 2
+parent 2
+child 2
+parent 3
+child 3
+parent 3
+child 3
+parent 3
+child 3
+parent 3
+child 3
+[1] [2] [3]
+-1- [2] [3]
+[1] -2- [3]
+[1] [2] -3-
+-1- -2- [3]
+-1- [2] -3-
+[1] -2- -3-
+-1- -2- -3-
+########
+use Config;
+$| = 1;
+$\ = "\n";
+fork()
+ ? print($Config{osname} eq $^O)
+ : print($Config{osname} eq $^O) ;
+EXPECT
+1
+1
+########
+$| = 1;
+$\ = "\n";
+fork()
+ ? do { require Config; print($Config::Config{osname} eq $^O); }
+ : do { require Config; print($Config::Config{osname} eq $^O); }
+EXPECT
+1
+1
+########
+$| = 1;
+use Cwd;
+$\ = "\n";
+my $dir;
+if (fork) {
+ $dir = "f$$.tst";
+ mkdir $dir, 0755;
+ chdir $dir;
+ print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent";
+ chdir "..";
+ rmdir $dir;
+}
+else {
+ sleep 2;
+ $dir = "f$$.tst";
+ mkdir $dir, 0755;
+ chdir $dir;
+ print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child";
+ chdir "..";
+ rmdir $dir;
+}
+EXPECT
+ok 1 parent
+ok 1 child
+########
+$| = 1;
+$\ = "\n";
+my $getenv;
+if ($^O eq 'MSWin32') {
+ $getenv = qq[$^X -e "print \$ENV{TST}"];
+}
+else {
+ $getenv = qq[$^X -e 'print \$ENV{TST}'];
+}
+if (fork) {
+ sleep 1;
+ $ENV{TST} = 'foo';
+ print "parent: " . `$getenv`;
+}
+else {
+ $ENV{TST} = 'bar';
+ print "child: " . `$getenv`;
+ sleep 1;
+}
+EXPECT
+parent: foo
+child: bar
+########
+$| = 1;
+$\ = "\n";
+if ($pid = fork) {
+ waitpid($pid,0);
+ print "parent got $?"
+}
+else {
+ exit(42);
+}
+EXPECT
+parent got 10752
+########
+$| = 1;
+$\ = "\n";
+my $echo = 'echo';
+if ($pid = fork) {
+ waitpid($pid,0);
+ print "parent got $?"
+}
+else {
+ exec("$echo foo");
+}
+EXPECT
+foo
+parent got 0
+########
+if (fork) {
+ die "parent died";
+}
+else {
+ die "child died";
+}
+EXPECT
+parent died at - line 2.
+child died at - line 5.
+########
+if ($pid = fork) {
+ eval { die "parent died" };
+ print $@;
+}
+else {
+ eval { die "child died" };
+ print $@;
+}
+EXPECT
+parent died at - line 2.
+child died at - line 6.
+########
+if (eval q{$pid = fork}) {
+ eval q{ die "parent died" };
+ print $@;
+}
+else {
+ eval q{ die "child died" };
+ print $@;
+}
+EXPECT
+parent died at (eval 2) line 1.
+child died at (eval 2) line 1.
+########
+BEGIN {
+ $| = 1;
+ fork and exit;
+ print "inner\n";
+}
+# XXX In emulated fork(), the child will not execute anything after
+# the BEGIN block, due to difficulties in recreating the parse stacks
+# and restarting yyparse() midstream in the child. This can potentially
+# be overcome by treating what's after the BEGIN{} as a brand new parse.
+#print "outer\n"
+EXPECT
+inner
# If you modify/add tests here, remember to update also t/lib/syslfs.t.
BEGIN {
- # Don't bother if there are no quads.
- eval { my $q = pack "q", 0 };
- if ($@) {
- print "1..0\n# no 64-bit types\n";
- exit(0);
- }
chdir 't' if -d 't';
unshift @INC, '../lib';
# Don't bother if there are no quad offsets.
EOM
}
+print "# checking whether we have sparse files...\n";
+
# Known have-nots.
if ($^O eq 'win32' || $^O eq 'vms') {
- print "1..0\n# no sparse files\n";
+ print "1..0\n# no sparse files (because this is $^O) \n";
bye();
}
# Known haves that have problems running this test
# (for example because they do not support sparse files, like UNICOS)
if ($^O eq 'unicos') {
- print "1..0\n# large files known to work but unable to test them here\n";
+ print "1..0\n# large files known to work but unable to test them here ($^O)\n";
bye();
}
-# Then try to deduce whether we have sparse files.
+# Then try to heuristically deduce whether we have sparse files.
# Let's not depend on Fcntl or any other extension.
bye();
}
+print "# we seem to have sparse files...\n";
+
# By now we better be sure that we do have sparse files:
# if we are not, the following will hog 5 gigabytes of disk. Ooops.
open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
binmode BIG;
-seek(BIG, 5_000_000_000, $SEEK_SET);
+unless (seek(BIG, 5_000_000_000, $SEEK_SET)) {
+ print "1..0\n# seeking past 2GB failed: $!\n";
+ explain();
+ bye();
+}
# Either the print or (more likely, thanks to buffering) the close will
# fail if there are are filesize limitations (process or fs).
my $print = print BIG "big";
-my $close = close BIG if $print;
+print "# print failed: $!\n" unless $print;
+my $close = close BIG;
+print "# close failed: $!\n" unless $close;
unless ($print && $close) {
- unless ($print) {
- print "# print failed: $!\n"
- } else {
- print "# close failed: $!\n"
- }
if ($! =~/too large/i) {
print "1..0\n# writing past 2GB failed: process limits?\n";
} elsif ($! =~ /quota/i) {
syntax error at (re_eval 1) line 1, near ""{"}"
Compilation failed in regexp at - line 1.
########
-BEGIN { @ARGV = qw(a b c) }
+BEGIN { @ARGV = qw(a b c d e) }
BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
END { print "end <",shift,">\nargv <@ARGV>\n" }
INIT { print "init <",shift,">\n" }
+STOP { print "stop <",shift,">\n" }
EXPECT
-argv <a b c>
+argv <a b c d e>
begin <a>
-init <b>
-end <c>
-argv <>
+stop <b>
+init <c>
+end <d>
+argv <e>
########
-l
# fdopen from a system descriptor to a system descriptor used to close
if ($x == 0) { print "" } else { print $x }
}
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in numeric eq (==) at - line 4.
$test++;
eval { ($x) = unpack 'a/a*/b*', '212ab' };
-print $@ eq '' && $x eq '100001100100' ? "ok $test\n" : "#$x,$@\nnot ok $test\n";
+my $expected_x = '100001100100';
+if ($Config{ebcdic} eq 'define') { $expected_x = '100000010100'; }
+print $@ eq '' && $x eq $expected_x ? "ok $test\n" : "#$x,$@\nnot ok $test\n";
$test++;
# 153..156: / with #
# the format supported by op/regexp.t. If you want to add a test
# that does fit that format, add it to op/re_tests, not here.
-print "1..193\n";
+print "1..194\n";
BEGIN {
chdir 't' if -d 't';
$text =~ /\GXb*X/g and print 'not ';
print "ok $test\n";
$test++;
+
+$text = "xA\n" x 500;
+$text =~ /^\s*A/m and print 'not ';
+print "ok $test\n";
+$test++;
([[:digit:]-z]+) =0-z= y $1 0-z
([[:digit:]-[:alpha:]]+) =0-z= y $1 0-z
\GX.*X aaaXbX n - -
+(\d+\.\d+) 3.1415926 y $1 3.1415926
+(\ba.{0,10}br) have a web browser y $1 a web br
+'\.c(pp|xx|c)?$'i Changes n - -
+'\.c(pp|xx|c)?$'i IO.c y - -
+'(\.c(pp|xx|c)?$)'i IO.c y $1 .c
+^([a-z]:) C:/ n - -
##
## Many of these tests are originally from Michael Schroeder
## <Michael.Schroeder@informatik.uni-erlangen.de>
-## Adapted and expanded by Gurusamy Sarathy <gsar@umich.edu>
+## Adapted and expanded by Gurusamy Sarathy <gsar@activestate.com>
##
chdir 't' if -d 't';
@a = sort { last ; } @a;
}
EXPECT
-Can't "last" outside a block at - line 3.
+Can't "last" outside a loop block at - line 3.
########
package TEST;
bar:
print "bar reached\n";
EXPECT
-Can't "goto" outside a block at - line 2.
+Can't "goto" out of a pseudo block at - line 2.
########
sub sortfn {
(split(/./, 'x'x10000))[0];
}
print "OK\n";
EXPECT
-Can't "next" outside a block at - line 8.
+Can't "next" outside a loop block at - line 8.
########
package TEST;
tie $bar, TEST;
}
EXPECT
-Can't "next" outside a block at - line 4.
+Can't "next" outside a loop block at - line 4.
########
@a = (1, 2, 3);
foo:
chdir 't' if -d 't';
unshift @INC, '../lib';
}
-print "1..38\n";
+print "1..49\n";
# XXX known to leak scalars
$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+sub backwards_stacked($$) { my($a,$b) = @_; $a lt $b ? 1 : $a gt $b ? -1 : 0 }
my $upperfirst = 'A' lt 'a';
print "# 2: x = '$x', expected = '$expected'\n";
print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
+$x = join('', sort( backwards_stacked @harry));
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 3: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 3\n" : "not ok 3\n");
+
$x = join('', sort @george, 'to', @harry);
$expected = $upperfirst ?
'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
-print "# 3: x = '$x', expected = '$expected'\n";
-print ($x eq $expected ?"ok 3\n":"not ok 3\n");
+print "# 4: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ?"ok 4\n":"not ok 4\n");
@a = ();
@b = reverse @a;
-print ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n");
+print ("@b" eq "" ? "ok 5\n" : "not ok 5 (@b)\n");
@a = (1);
@b = reverse @a;
-print ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n");
+print ("@b" eq "1" ? "ok 6\n" : "not ok 6 (@b)\n");
@a = (1,2);
@b = reverse @a;
-print ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n");
+print ("@b" eq "2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
@a = (1,2,3);
@b = reverse @a;
-print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
+print ("@b" eq "3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
@a = (1,2,3,4);
@b = reverse @a;
-print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
+print ("@b" eq "4 3 2 1" ? "ok 9\n" : "not ok 9 (@b)\n");
@a = (10,2,3,4);
@b = sort {$a <=> $b;} @a;
-print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
+print ("@b" eq "2 3 4 10" ? "ok 10\n" : "not ok 10 (@b)\n");
$sub = 'backwards';
$x = join('', sort $sub @harry);
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
-print "# 10: x = $x, expected = '$expected'\n";
-print ($x eq $expected ? "ok 10\n" : "not ok 10\n");
+print "# 11: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 11\n" : "not ok 11\n");
+
+$sub = 'backwards_stacked';
+$x = join('', sort $sub @harry);
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 12: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 12\n" : "not ok 12\n");
# literals, combinations
@b = sort (4,1,3,2);
-print ("@b" eq '1 2 3 4' ? "ok 11\n" : "not ok 11\n");
+print ("@b" eq '1 2 3 4' ? "ok 13\n" : "not ok 13\n");
print "# x = '@b'\n";
@b = sort grep { $_ } (4,1,3,2);
-print ("@b" eq '1 2 3 4' ? "ok 12\n" : "not ok 12\n");
+print ("@b" eq '1 2 3 4' ? "ok 14\n" : "not ok 14\n");
print "# x = '@b'\n";
@b = sort map { $_ } (4,1,3,2);
-print ("@b" eq '1 2 3 4' ? "ok 13\n" : "not ok 13\n");
+print ("@b" eq '1 2 3 4' ? "ok 15\n" : "not ok 15\n");
print "# x = '@b'\n";
@b = sort reverse (4,1,3,2);
-print ("@b" eq '1 2 3 4' ? "ok 14\n" : "not ok 14\n");
+print ("@b" eq '1 2 3 4' ? "ok 16\n" : "not ok 16\n");
print "# x = '@b'\n";
$^W = 0;
# redefining sort sub inside the sort sub should fail
sub twoface { *twoface = sub { $a <=> $b }; &twoface }
eval { @b = sort twoface 4,1,3,2 };
-print ($@ =~ /redefine active sort/ ? "ok 15\n" : "not ok 15\n");
+print ($@ =~ /redefine active sort/ ? "ok 17\n" : "not ok 17\n");
# redefining sort subs outside the sort should not fail
eval { *twoface = sub { &backwards } };
-print $@ ? "not ok 16\n" : "ok 16\n";
+print $@ ? "not ok 18\n" : "ok 18\n";
eval { @b = sort twoface 4,1,3,2 };
-print ("@b" eq '4 3 2 1' ? "ok 17\n" : "not ok 17 |@b|\n");
+print ("@b" eq '4 3 2 1' ? "ok 19\n" : "not ok 19 |@b|\n");
*twoface = sub { *twoface = *backwards; $a <=> $b };
eval { @b = sort twoface 4,1 };
-print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n");
+print ($@ =~ /redefine active sort/ ? "ok 20\n" : "not ok 20\n");
*twoface = sub {
eval 'sub twoface { $a <=> $b }';
- die($@ =~ /redefine active sort/ ? "ok 19\n" : "not ok 19\n");
+ die($@ =~ /redefine active sort/ ? "ok 21\n" : "not ok 21\n");
$a <=> $b;
};
eval { @b = sort twoface 4,1 };
-print $@ ? "$@" : "not ok 19\n";
+print $@ ? "$@" : "not ok 21\n";
eval <<'CODE';
my @result = sort main'backwards 'one', 'two';
CODE
-print $@ ? "not ok 20\n# $@" : "ok 20\n";
+print $@ ? "not ok 22\n# $@" : "ok 22\n";
eval <<'CODE';
# "sort 'one', 'two'" should not try to parse "'one" as a sort sub
my @result = sort 'one', 'two';
CODE
-print $@ ? "not ok 21\n# $@" : "ok 21\n";
+print $@ ? "not ok 23\n# $@" : "ok 23\n";
{
my $sortsub = \&backwards;
my $sortglobr = \*backwards;
my $sortname = 'backwards';
@b = sort $sortsub 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 22\n" : "not ok 22 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n");
@b = sort $sortglob 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 23\n" : "not ok 23 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n");
@b = sort $sortname 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n");
@b = sort $sortglobr 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n");
+}
+
+{
+ my $sortsub = \&backwards_stacked;
+ my $sortglob = *backwards_stacked;
+ my $sortglobr = \*backwards_stacked;
+ my $sortname = 'backwards_stacked';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 30\n" : "not ok 30 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 31\n" : "not ok 31 |@b|\n");
}
{
local $sortglobr = \*backwards;
local $sortname = 'backwards';
@b = sort $sortsub 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 32\n" : "not ok 32 |@b|\n");
@b = sort $sortglob 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 33\n" : "not ok 33 |@b|\n");
@b = sort $sortname 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 34\n" : "not ok 34 |@b|\n");
@b = sort $sortglobr 4,1,3,2;
- print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n");
+ print ("@b" eq '4 3 2 1' ? "ok 35\n" : "not ok 35 |@b|\n");
+}
+
+{
+ local $sortsub = \&backwards_stacked;
+ local $sortglob = *backwards_stacked;
+ local $sortglobr = \*backwards_stacked;
+ local $sortname = 'backwards_stacked';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 36\n" : "not ok 36 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 37\n" : "not ok 37 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 38\n" : "not ok 38 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 39\n" : "not ok 39 |@b|\n");
}
## exercise sort builtins... ($a <=> $b already tested)
my $dummy; # force blockness
return $b <=> $a
} @a;
-print ("@b" eq '1996 255 90 19 5' ? "ok 30\n" : "not ok 30\n");
+print ("@b" eq '1996 255 90 19 5' ? "ok 40\n" : "not ok 40\n");
print "# x = '@b'\n";
$x = join('', sort { $a cmp $b } @harry);
$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
-print ($x eq $expected ? "ok 31\n" : "not ok 31\n");
+print ($x eq $expected ? "ok 41\n" : "not ok 41\n");
print "# x = '$x'; expected = '$expected'\n";
$x = join('', sort { $b cmp $a } @harry);
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
-print ($x eq $expected ? "ok 32\n" : "not ok 32\n");
+print ($x eq $expected ? "ok 42\n" : "not ok 42\n");
print "# x = '$x'; expected = '$expected'\n";
{
use integer;
@b = sort { $a <=> $b } @a;
- print ("@b" eq '5 19 90 255 1996' ? "ok 33\n" : "not ok 33\n");
+ print ("@b" eq '5 19 90 255 1996' ? "ok 43\n" : "not ok 43\n");
print "# x = '@b'\n";
@b = sort { $b <=> $a } @a;
- print ("@b" eq '1996 255 90 19 5' ? "ok 34\n" : "not ok 34\n");
+ print ("@b" eq '1996 255 90 19 5' ? "ok 44\n" : "not ok 44\n");
print "# x = '@b'\n";
$x = join('', sort { $a cmp $b } @harry);
$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
- print ($x eq $expected ? "ok 35\n" : "not ok 35\n");
+ print ($x eq $expected ? "ok 45\n" : "not ok 45\n");
print "# x = '$x'; expected = '$expected'\n";
$x = join('', sort { $b cmp $a } @harry);
$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
- print ($x eq $expected ? "ok 36\n" : "not ok 36\n");
+ print ($x eq $expected ? "ok 46\n" : "not ok 46\n");
print "# x = '$x'; expected = '$expected'\n";
}
# test that an optimized-away comparison block doesn't take any other
# arguments away with it
$x = join('', sort { $a <=> $b } 3, 1, 2);
-print $x eq "123" ? "ok 37\n" : "not ok 37\n";
+print $x eq "123" ? "ok 47\n" : "not ok 47\n";
# test sorting in non-main package
package Foo;
@a = ( 5, 19, 1996, 255, 90 );
@b = sort { $b <=> $a } @a;
-print ("@b" eq '1996 255 90 19 5' ? "ok 38\n" : "not ok 38\n");
+print ("@b" eq '1996 255 90 19 5' ? "ok 48\n" : "not ok 48\n");
+print "# x = '@b'\n";
+
+@b = sort main::backwards_stacked @a;
+print ("@b" eq '90 5 255 1996 19' ? "ok 49\n" : "not ok 49\n");
print "# x = '@b'\n";
require Config; import Config;
}
-print "1..83\n";
+print "1..84\n";
$x = 'foo';
$_ = "x";
eval q% ($_ = "x") =~ s/x(($x)*)/"$1"/e %;
print +($_ eq '' and !length $@) ? "ok 83\n" : "not ok 83\n# \$_ eq $_, $@\n";
+$_ = "C:/";
+s/^([a-z]:)/\u$1/ and print "not ";
+print "ok 84\n";
entertaining.
And they say we'll have some fun if it stops raining!
+=head1 Additional tests
+
+=head2 item without over
+
+=item oops
+
+=head2 back without over
+
+=back
+
+=head2 over without back
+
+=over 4
+
+=item oops
+
+=head2 end without begin
+
+=end
+
+=head2 begin and begin
+
+=begin html
+
+=begin text
+
+=end
+
+=end
+
+=head2 Nested sequences of the same type
+
+C<code I<italic C<code again!>>>
+
+=head2 Garbled entities
+
+E<alea iacta est>
+E<C<auml>>
+E<abcI<bla>>
+
+=head2 Unresolved internal links
+
+L</"begin or begin">
+L<"end with begin">
+L</OoPs>
+
+=head2 Garbled (almost) links
+
+L<s s / s s / ss>
+L<".".":">
+L<"h"/"hh">
+L<a|b|c>
+
+=head2 Warnings
+
+L<passwd(5)>
+L< some text|page/"section" >
+
+=over 4
+
+=item bla
+
+=back 200
+
+=begin html
+
+What?
+
+=end xml
+
+=over 4
+
+=back
+
+see these unescaped < and > in the text?
+
=cut
+
*** ERROR: Unknown interior-sequence "D" at line 22 in file pod/poderrs.t
*** ERROR: Unknown interior-sequence "Q" at line 25 in file pod/poderrs.t
*** ERROR: Unknown interior-sequence "A" at line 26 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t
*** ERROR: Unknown interior-sequence "Y" at line 27 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t
** Unterminated B<...> at pod/poderrs.t line 31
** Unterminated I<...> at pod/poderrs.t line 30
** Unterminated C<...> at pod/poderrs.t line 33
-pod/poderrs.t has 10 pod syntax errors.
+*** ERROR: =item without previous =over at line 43 in file pod/poderrs.t
+*** ERROR: =back without previous =over at line 47 in file pod/poderrs.t
+*** ERROR: unclosed =over (line 51) at head2 at line 55 in file pod/poderrs.t
+*** WARNING: =end without =begin at line 57 in file pod/poderrs.t
+*** ERROR: Nested =begin's (first at line 61:html) at line 63 in file pod/poderrs.t
+*** WARNING: =end without =begin at line 67 in file pod/poderrs.t
+*** ERROR: nested commands C<...C<...>...> at line 71 in file pod/poderrs.t
+*** ERROR: garbled entity E<alea iacta est> at line 75 in file pod/poderrs.t
+*** ERROR: garbled entity E<C<auml>> at line 76 in file pod/poderrs.t
+*** ERROR: garbled entity E<abcI<bla>> at line 77 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `s s / s s / ss') at line 87 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `".".":"') at line 88 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `"h"/"hh"') at line 89 in file pod/poderrs.t
+*** WARNING: brackets in `passwd(5)' at line 94 in file pod/poderrs.t
+*** WARNING: ignoring leading whitespace in link at line 95 in file pod/poderrs.t
+*** WARNING: ignoring trailing whitespace in link at line 95 in file pod/poderrs.t
+*** WARNING: Spurious character(s) after =back at line 101 in file pod/poderrs.t
+*** WARNING: Spurious character(s) after =end at line 107 in file pod/poderrs.t
+*** WARNING: No items in =over (at line 109) / =back list at line 111 in file pod/poderrs.t
+*** WARNING: 2 unescaped <> at line 113 in file pod/poderrs.t
+*** ERROR: unresolved internal link `begin or begin' at line 81 in file pod/poderrs.t
+*** ERROR: unresolved internal link `end with begin' at line 82 in file pod/poderrs.t
+*** ERROR: unresolved internal link `OoPs' at line 83 in file pod/poderrs.t
+*** ERROR: unresolved internal link `b|c' at line 90 in file pod/poderrs.t
+pod/poderrs.t has 25 pod syntax errors.
}
sub msgcmp( $ $ ) {
- ## filter out platform-dependent aspects of error messages
my ($line1, $line2) = @_;
- for ($line1, $line2) {
- if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
- my $fname = $1;
- s/^#*\s*// if ($^O eq 'MacOS');
- s/^\s*\Q$fname\E/stripname($fname)/e;
- }
- elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
- s/^#*\s*// if ($^O eq 'MacOS');
- s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
- s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
- }
- }
return $line1 ne $line2;
}
Yiddish:::1 15
EOF
+if ($^O eq 'os390') {
+ $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
+ $locales =~ s/Thai:th:th:11 tis620\n//;
+}
+
sub in_utf8 () { $^H & 0x08 }
if (in_utf8) {
push @enc, $_;
}
}
+ if ($^O eq 'os390') {
+ push @enc, qw(IBM-037 IBM-819 IBM-1047);
+ }
return @enc;
}
$^W = 1 ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in scalar chop at - line 4.
########
# warnings enabled at compile time, disabled at run time
$^W = 1 ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 5.
+Use of uninitialized value in scalar chop at - line 5.
########
-w
--FILE-- abcd
--FILE--
require "./abcd";
EXPECT
-Use of uninitialized value at ./abcd line 1.
+Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
#! perl -w
require "./abcd";
EXPECT
-Use of uninitialized value at ./abcd line 1.
+Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
$^W =1 ;
require "./abcd";
EXPECT
-Use of uninitialized value at ./abcd line 1.
+Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
require "./abcd";
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
$^W = 1;
eval 'my $b ; chop $b ;' ;
print $@ ;
EXPECT
-Use of uninitialized value at (eval 1) line 1.
+Use of uninitialized value in scalar chop at (eval 1) line 1.
########
eval '$^W = 1;' ;
print $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in scalar chop at - line 4.
########
eval {$^W = 1;} ;
print $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in scalar chop at - line 4.
########
{
}
my $c ; chop $c ;
EXPECT
-Use of uninitialized value at - line 5.
+Use of uninitialized value in scalar chop at - line 5.
########
-w
-e undef
EXPECT
-Use of uninitialized value at - line 2.
+Use of uninitialized value in -e at - line 2.
########
$^W = 1 + 2 ;
fred() ;
}
EXPECT
-Use of uninitialized value at - line 2.
+Use of uninitialized value in scalar chop at - line 2.
}
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check runtime scope of pragma
}
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check runtime scope of pragma
}
&$a ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
use warnings 'deprecated' ;
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at ./abc line 2.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
--FILE-- abc.pm
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at abc.pm line 2.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
# Check scope of pragma with eval
}; print STDERR $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check scope of pragma with eval
}; print STDERR $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 5.
-Use of uninitialized value at - line 7.
+Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
}; print STDERR $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
]; print STDERR $@;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at (eval 1) line 3.
+Use of uninitialized value in scalar chop at (eval 1) line 3.
########
# Check scope of pragma with eval
'; print STDERR $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at (eval 1) line 2.
-Use of uninitialized value at - line 7.
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
'; print STDERR $@ ;
my $b ; chop $b ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
1 if $a EQ $b ;
EXPECT
Use of EQ is deprecated at - line 6.
-Use of uninitialized value at - line 9.
-Use of uninitialized value at - line 11.
-Use of uninitialized value at - line 11.
+Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value in string eq at - line 11.
+Use of uninitialized value in string eq at - line 11.
}
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
}
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 5.
+Use of uninitialized value in scalar chop at - line 5.
########
# Check interaction of $^W and use warnings
BEGIN { $^W = 0 }
fred() ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 10.
+Use of uninitialized value in scalar chop at - line 10.
########
# Check interaction of $^W and use warnings
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 7.
+Use of uninitialized value in scalar chop at - line 7.
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at abc.pm line 3.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at ./abc line 3.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc.pm
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at abc.pm line 3.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc
my $a ; chop $a ;
EXPECT
Use of EQ is deprecated at ./abc line 3.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check runtime scope of pragma
&$a ;
print STDERR "The End.\n" ;
EXPECT
-Use of uninitialized value at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
########
--FILE-- abc
print STDERR "The End.\n" ;
EXPECT
Use of EQ is deprecated at ./abc line 2.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
--FILE-- abc.pm
print STDERR "The End.\n" ;
EXPECT
Use of EQ is deprecated at abc.pm line 2.
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
# Check scope of pragma with eval
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
--- Use of uninitialized value at - line 6.
+-- Use of uninitialized value in scalar chop at - line 6.
The End.
########
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
--- Use of uninitialized value at - line 5.
-Use of uninitialized value at - line 7.
+-- Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
--- Use of uninitialized value at (eval 1) line 3.
+-- Use of uninitialized value in scalar chop at (eval 1) line 3.
The End.
########
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
--- Use of uninitialized value at (eval 1) line 2.
-Use of uninitialized value at - line 7.
+-- Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-Use of uninitialized value at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
no warnings 'uninitialized' ;
print $b ;
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in print at - line 3.
########
# doio.c [Perl_my_stat Perl_my_lstat]
use warnings 'io' ;
no warnings 'uninitialized' ;
my $c = $$a;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in scalar dereference at - line 4.
########
# pp.c
use warnings 'unsafe' ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
-Can't "last" outside a block at - line 4.
+Can't "last" outside a loop block at - line 4.
########
# pp_ctl.c
use warnings 'unsafe' ;
no warnings 'uninitialized' ;
my @c = @$a;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in array dereference at - line 4.
########
# pp_hot.c [pp_rv2hv]
use warnings 'uninitialized' ;
no warnings 'uninitialized' ;
my %c = %$a;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in hash dereference at - line 4.
########
# pp_hot.c [pp_aassign]
use warnings 'unsafe' ;
/[[.foo.]]/;
/[[=bar=]]/;
/[:zog:]/;
+BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 }
/[[:zog:]]/;
EXPECT
Character class syntax [: :] belongs inside character classes at - line 4.
Character class syntax [. .] is reserved for future extensions at - line 8.
Character class syntax [= =] is reserved for future extensions at - line 9.
Character class syntax [: :] belongs inside character classes at - line 10.
-Character class [:zog:] unknown at - line 19.
+Character class [:zog:] unknown at - line 20.
########
# regcomp.c [S_regclass]
$_ = "";
no warnings 'uninitialized' ;
$x = 1 + $b[0] ; # a
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in integer addition (+) at - line 4.
########
# sv.c (sv_2iv)
package fred ;
no warnings 'uninitialized' ;
$A *= 2 ;
EXPECT
-Use of uninitialized value at - line 10.
+Use of uninitialized value in integer multiplication (*) at - line 10.
########
# sv.c
use integer ;
no warnings 'uninitialized' ;
my $y *= 2 ; #b
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in integer multiplication (*) at - line 4.
########
# sv.c (sv_2uv)
package fred ;
$B = 0 ;
$B |= $A ;
EXPECT
-Use of uninitialized value at - line 10.
+Use of uninitialized value in bitwise or (|) at - line 10.
########
# sv.c
use warnings 'uninitialized' ;
my $Y = 1 ;
$x = 1 | $b[$Y] ;
EXPECT
-Use of uninitialized value at - line 4.
+Use of uninitialized value in bitwise or (|) at - line 4.
########
# sv.c
use warnings 'uninitialized' ;
no warnings 'uninitialized' ;
my $y *= 1 ; # d
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in multiplication (*) at - line 3.
########
# sv.c
use warnings 'uninitialized' ;
no warnings 'uninitialized' ;
$x = 1 + $b[0] ; # e
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in addition (+) at - line 3.
########
# sv.c (sv_2nv)
package fred ;
no warnings 'uninitialized' ;
$A *= 2 ;
EXPECT
-Use of uninitialized value at - line 9.
+Use of uninitialized value in multiplication (*) at - line 9.
########
# sv.c
use warnings 'uninitialized' ;
no warnings 'uninitialized' ;
$x = $z + 1 ; # f
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in addition (+) at - line 3.
########
# sv.c
use warnings 'uninitialized' ;
no warnings 'uninitialized' ;
$x = chop $z ; # h
EXPECT
-Use of uninitialized value at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
########
# sv.c (sv_2pv)
package fred ;
$C = "" ;
$C .= $A ;
EXPECT
-Use of uninitialized value at - line 10.
+Use of uninitialized value in concatenation (.) at - line 10.
########
# sv.c
use warnings 'numeric' ;
#include "perl.h"
void
-Perl_taint_proper(pTHX_ const char *f, char *s)
+Perl_taint_proper(pTHX_ const char *f, const char *s)
{
dTHR; /* just for taint */
char *ug;
-#if Uid_t_SIGN == -1
+#ifdef HAS_SETEUID
DEBUG_u(PerlIO_printf(Perl_debug_log,
- "%s %d %"IVdf" %"IVdf"\n", s, PL_tainted, (IV)PL_uid, (IV)PL_euid));
-#else
- DEBUG_u(PerlIO_printf(Perl_debug_log,
- "%s %d %"UVuf" %"UVuf"\n", s, PL_tainted, (UV)PL_uid, (UV)PL_euid));
+ "%s %d %"Uid_t_f" %"Uid_t_f"\n", s, PL_tainted, PL_uid, PL_euid));
#endif
if (PL_tainted) {
static char ident_too_long[] = "Identifier too long";
static void restore_rsfp(pTHXo_ void *f);
-static void restore_expect(pTHXo_ void *e);
-static void restore_lex_expect(pTHXo_ void *e);
+
+#define XFAKEBRACK 128
+#define XENUMMASK 127
#define UTF (PL_hints & HINT_UTF8)
/*
#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
+#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
/*
* Convenience functions to return different tokens and prime the
SAVEI32(PL_lex_dojoin);
SAVEI32(PL_lex_brackets);
- SAVEI32(PL_lex_fakebrack);
SAVEI32(PL_lex_casemods);
SAVEI32(PL_lex_starts);
SAVEI32(PL_lex_state);
- SAVESPTR(PL_lex_inpat);
+ SAVEVPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_bufend);
SAVEPPTR(PL_oldbufptr);
SAVEI32(PL_lex_defer);
SAVEI32(PL_sublex_info.sub_inwhat);
SAVESPTR(PL_lex_repl);
- SAVEDESTRUCTOR_X(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
- SAVEDESTRUCTOR_X(restore_lex_expect, PL_tokenbuf + PL_expect);
+ SAVEINT(PL_expect);
+ SAVEINT(PL_lex_expect);
PL_lex_state = LEX_NORMAL;
PL_lex_defer = 0;
PL_expect = XSTATE;
PL_lex_brackets = 0;
- PL_lex_fakebrack = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
SAVEFREEPV(PL_lex_brackstack);
* S_incline
* This subroutine has nothing to do with tilting, whether at windmills
* or pinball tables. Its name is short for "increment line". It
- * increments the current line number in PL_curcop->cop_line and checks
+ * increments the current line number in CopLINE(PL_curcop) and checks
* to see whether the line starts with a comment of the form
* # line 500 "foo.pm"
* If so, it sets the current line number and file to the values in the comment.
char ch;
int sawline = 0;
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (*s++ != '#')
return;
while (*s == ' ' || *s == '\t') s++;
ch = *t;
*t = '\0';
if (t - s > 0)
- PL_curcop->cop_filegv = gv_fetchfile(s);
+ CopFILE_set(PL_curcop, s);
else
- PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+ CopFILE_set(PL_curcop, PL_origfilename);
*t = ch;
- PL_curcop->cop_line = atoi(n)-1;
+ CopLINE_set(PL_curcop, atoi(n)-1);
}
/*
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
*/
STATIC I32
-S_lop(pTHX_ I32 f, expectation x, char *s)
+S_lop(pTHX_ I32 f, int x, char *s)
{
dTHR;
yylval.ival = f;
PL_lex_state = PL_sublex_info.super_state;
SAVEI32(PL_lex_dojoin);
SAVEI32(PL_lex_brackets);
- SAVEI32(PL_lex_fakebrack);
SAVEI32(PL_lex_casemods);
SAVEI32(PL_lex_starts);
SAVEI32(PL_lex_state);
- SAVESPTR(PL_lex_inpat);
+ SAVEVPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
PL_lex_dojoin = FALSE;
PL_lex_brackets = 0;
- PL_lex_fakebrack = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
SAVEFREEPV(PL_lex_brackstack);
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
PL_lex_state = LEX_INTERPCONCAT;
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
PL_lex_inwhat = PL_sublex_info.sub_inwhat;
if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
PL_lex_brackets = 0;
- PL_lex_fakebrack = 0;
PL_lex_casemods = 0;
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ?
OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
: UTF;
- char *leaveit = /* set of acceptably-backslashed characters */
+ const char *leaveit = /* set of acceptably-backslashed characters */
PL_lex_inpat
? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
: "";
/* \132 indicates an octal constant */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
- *d++ = scan_oct(s, 3, &len);
+ *d++ = (char)scan_oct(s, 3, &len);
s += len;
continue;
}
/* note: utf always shorter than hex */
d = (char*)uv_to_utf8((U8*)d,
- scan_hex(s + 1, e - s - 1, &len));
+ (UV)scan_hex(s + 1, e - s - 1, &len));
s = e + 1;
}
else {
* store private buffers and state information.
*
* The supplied datasv parameter is upgraded to a PVIO type
- * and the IoDIRP field is used to store the function pointer.
+ * and the IoDIRP field is used to store the function pointer,
+ * and IOf_FAKE_DIRP is enabled on datasv to mark this as such.
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
- if (!funcp){ /* temporary handy debugging hack to be deleted */
- PL_filter_debug = atoi((char*)datasv);
- return NULL;
- }
+ if (!funcp)
+ return Nullsv;
+
if (!PL_rsfp_filters)
PL_rsfp_filters = newAV();
if (!datasv)
if (!SvUPGRADE(datasv, SVt_PVIO))
Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
-#ifdef DEBUGGING
- if (PL_filter_debug) {
- STRLEN n_a;
- Perl_warn(aTHX_ "filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
- }
-#endif /* DEBUGGING */
+ IoFLAGS(datasv) |= IOf_FAKE_DIRP;
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
+ funcp, SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
void
Perl_filter_del(pTHX_ filter_t funcp)
{
-#ifdef DEBUGGING
- if (PL_filter_debug)
- Perl_warn(aTHX_ "filter_del func %p", funcp);
-#endif /* DEBUGGING */
+ SV *datasv;
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
- IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
+ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
+ if (IoDIRP(datasv) == (DIR*)funcp) {
+ IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
+ IoDIRP(datasv) = (DIR*)NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
-#ifdef DEBUGGING
- if (PL_filter_debug)
- Perl_warn(aTHX_ "filter_read %d: from rsfp\n", idx);
-#endif /* DEBUGGING */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: from rsfp\n", idx));
if (maxlen) {
/* Want a block */
int len ;
}
/* Skip this filter slot if filter has been deleted */
if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
-#ifdef DEBUGGING
- if (PL_filter_debug)
- Perl_warn(aTHX_ "filter_read %d: skipped (filter deleted)\n", idx);
-#endif /* DEBUGGING */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: skipped (filter deleted)\n",
+ idx));
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
-#ifdef DEBUGGING
- if (PL_filter_debug) {
- STRLEN n_a;
- Perl_warn(aTHX_ "filter_read %d: via function %p (%s)\n",
- idx, funcp, SvPV(datasv,n_a));
- }
-#endif /* DEBUGGING */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: via function %p (%s)\n",
+ idx, funcp, SvPV_nolen(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
}
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- if (PL_curcop->cop_line == 1) {
+ if (CopLINE(PL_curcop) == 1) {
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
+ if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
PL_expect = XTERM;
TOKEN('(');
case ';':
- if (PL_curcop->cop_line < PL_copline)
- PL_copline = PL_curcop->cop_line;
+ if (CopLINE(PL_curcop) < PL_copline)
+ PL_copline = CopLINE(PL_curcop);
tmp = *s++;
OPERATOR(tmp);
case ')':
}
break;
}
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
if (isSPACE(*s) || *s == '#')
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
PL_lex_formbrack = 0;
if (PL_lex_state == LEX_INTERPNORMAL) {
if (PL_lex_brackets == 0) {
- if (PL_lex_fakebrack) {
+ if (PL_expect & XFAKEBRACK) {
+ PL_expect &= XENUMMASK;
PL_lex_state = LEX_INTERPEND;
PL_bufptr = s;
return yylex(); /* ignore fake brackets */
PL_lex_state = LEX_INTERPEND;
}
}
- if (PL_lex_brackets < PL_lex_fakebrack) {
+ if (PL_expect & XFAKEBRACK) {
+ PL_expect &= XENUMMASK;
PL_bufptr = s;
- PL_lex_fakebrack = 0;
return yylex(); /* ignore fake brackets */
}
force_next('}');
s--;
if (PL_expect == XOPERATOR) {
if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
BAop(OP_BIT_AND);
}
}
else if (gv && !gvp
&& -tmp==KEY_lock /* XXX generalizable kludge */
+ && GvCVu(gv)
&& !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
{
tmp = 0; /* any sub overrides "weak" keyword */
if (PL_expect == XOPERATOR) {
if (PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
else
no_op("Bareword",s);
case KEY___FILE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- newSVsv(GvSV(PL_curcop->cop_filegv)));
+ newSVpv(CopFILE(PL_curcop),0));
TERM(THING);
case KEY___LINE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%"IVdf, (IV)PL_curcop->cop_line));
+ Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
TERM(THING);
case KEY___PACKAGE__:
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
+ case KEY_STOP:
case KEY_INIT:
if (PL_expect == XSTATE) {
s = PL_bufptr;
case KEY_crypt:
#ifdef FCRYPT
- if (!PL_cryptseen++)
+ if (!PL_cryptseen) {
+ PL_cryptseen = TRUE;
init_des();
+ }
#endif
LOP(OP_CRYPT,XTERM);
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(ELSIF);
case KEY_eq:
case KEY_for:
case KEY_foreach:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
s = skipspace(s);
if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
char *p = s;
UNI(OP_HEX);
case KEY_if:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(IF);
case KEY_index:
UNI(OP_STAT);
case KEY_study:
- PL_sawstudy++;
UNI(OP_STUDY);
case KEY_substr:
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNLESS);
case KEY_unlink:
UNI(OP_VALUES);
case KEY_vec:
- PL_sawvec = TRUE;
LOP(OP_VEC,XTERM);
case KEY_while:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
case KEY_warn:
break;
}
break;
+ case 'S':
+ if (strEQ(d,"STOP")) return KEY_STOP;
+ break;
case 's':
switch (d[1]) {
case 0: return KEY_s;
and type is used with error messages only. */
STATIC SV *
-S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
+S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
+ const char *type)
{
dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV **cvp;
SV *cv, *typesv;
- char *why, *why1, *why2;
+ const char *why, *why1, *why2;
if (!(PL_hints & HINT_LOCALIZE_HH)) {
SV *msg;
char *bracket = 0;
char funny = *s++;
- if (PL_lex_brackets == 0)
- PL_lex_fakebrack = 0;
if (isSPACE(*s))
s = skipspace(s);
d = dest;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
dTHR; /* only for ckWARN */
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
- char *brack = *s == '[' ? "[...]" : "{...}";
+ const char *brack = *s == '[' ? "[...]" : "{...}";
Perl_warner(aTHX_ WARN_AMBIGUOUS,
"Ambiguous use of %c{%s%s} resolved to %c%s%s",
funny, dest, brack, funny, dest, brack);
}
- PL_lex_fakebrack = PL_lex_brackets+1;
bracket++;
- PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
+ PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
return s;
}
}
}
CLINE;
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
while (s < bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(herewas,bufptr,d-bufptr+1);
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= PL_bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
- PL_curcop->cop_line++; /* the preceding stmt passes a newline */
+ CopLINE_inc(PL_curcop); /* the preceding stmt passes a newline */
sv_catpvn(herewas,s,PL_bufend-s);
sv_setsv(PL_linestr,herewas);
while (s >= PL_bufend) { /* multiple line string? */
if (!outer ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),
- (I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
s = PL_bufend - 1;
}
s++;
retval:
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
/* after skipping whitespace, the next character is the terminator */
term = *s;
/* mark where we are */
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = term;
/* find corresponding closing delimiter */
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the current line number */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* handle quoted delimiters */
if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
if (!keep_quoted && s[1] == term)
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the line count */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* backslashes can escape the open or closing characters */
if (*s == '\\' && s+1 < PL_bufend) {
if (!keep_quoted &&
if (!PL_rsfp ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
sv_free(sv);
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
return Nullch;
}
/* we read a line, so increment our line counter */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),
- (I32)PL_curcop->cop_line, sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
}
/* having changed the buffer, we must update PL_bufend */
if (keep_delims)
sv_catpvn(sv, s, 1);
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
s++;
/* if we allocated too much space, give some back */
if (PL_compcv) {
assert(SvTYPE(PL_compcv) == SVt_PVCV);
}
- save_I32(&PL_subline);
+ SAVEI32(PL_subline);
save_item(PL_subname);
SAVEI32(PL_padix);
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
SAVESPTR(PL_comppad);
SAVESPTR(PL_comppad_name);
SAVESPTR(PL_compcv);
PL_comppad_name_fill = 0;
PL_min_intro_pending = 0;
PL_padix = 0;
- PL_subline = PL_curcop->cop_line;
+ PL_subline = CopLINE(PL_curcop);
#ifdef USE_THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
where = SvPVX(where_sv);
}
msg = sv_2mortal(newSVpv(s, 0));
- Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
- GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+ Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
+ CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
- if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
+ if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
Perl_sv_catpvf(aTHX_ msg,
" (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
else
qerror(msg);
if (PL_error_count >= 10)
- Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
+ Perl_croak(aTHX_ "%s has too many errors.\n", CopFILE(PL_curcop));
PL_in_my = 0;
PL_in_my_stash = Nullhv;
return 0;
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
PerlIO_close(PL_rsfp);
PL_rsfp = fp;
}
-
-/*
- * restore_expect
- * Restores the state of PL_expect when the lexing that begun with a
- * start_lex() call has ended.
- */
-
-static void
-restore_expect(pTHXo_ void *e)
-{
- /* a safe way to store a small integer in a pointer */
- PL_expect = (expectation)((char *)e - PL_tokenbuf);
-}
-
-/*
- * restore_lex_expect
- * Restores the state of PL_lex_expect when the lexing that begun with a
- * start_lex() call has ended.
- */
-
-static void
-restore_lex_expect(pTHXo_ void *e)
-{
- /* a safe way to store a small integer in a pointer */
- PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
-}
newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, file);
}
-#ifdef PERL_OBJECT
-#define NO_XSLOCKS
-#endif /* PERL_OBJECT */
-
#include "XSUB.h"
XS(XS_UNIVERSAL_isa)
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
*d++ = (( uv & 0x3f) | 0x80);
return d;
}
-#ifdef Quad_t
+#ifdef HAS_QUAD
if (uv < 0x2000000000)
#endif
{
*d++ = (( uv & 0x3f) | 0x80);
return d;
}
-#ifdef Quad_t
+#ifdef HAS_QUAD
{
*d++ = 0xff; /* Can't match U+FFFE! */
*d++ = (((uv >> 36) & 0x3f) | 0x80);
Perl_croak_nocontext("panic: malloc");
#endif
ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
+ PERL_ALLOC_CHECK(ptr);
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
if (ptr != Nullch)
return ptr;
else if (PL_nomemok)
Perl_croak_nocontext("panic: realloc");
#endif
ptr = PerlMem_realloc(where,size);
-
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++));
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size));
+ PERL_ALLOC_CHECK(ptr);
+
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
if (ptr != Nullch)
return ptr;
Perl_safesysfree(Malloc_t where)
{
dTHX;
- DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++));
+ DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
if (where) {
/*SUPPRESS 701*/
PerlMem_free(where);
#endif
size *= count;
ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
+ PERL_ALLOC_CHECK(ptr);
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size));
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
return ptr;
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
dTHR;
- if (PL_curcop->cop_line)
- Perl_sv_catpvf(aTHX_ sv, " at %_ line %"IVdf,
- GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+ if (CopLINE(PL_curcop))
+ Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
+ CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
bool line_mode = (RsSIMPLE(PL_rs) &&
SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
else
message = SvPV(msv,msglen);
- DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%lx %s",
- (unsigned long) thr, message));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s",
+ PTR2UV(thr), message));
if (PL_diehook) {
/* sv_2cv might call Perl_croak() */
if (ckDEAD(err)) {
#ifdef USE_THREADS
- DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%lx %s", (unsigned long) thr, message));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message));
#endif /* USE_THREADS */
if (PL_diehook) {
/* sv_2cv might call Perl_croak() */
#endif
/* VMS' my_popen() is in VMS.c, same with OS/2. */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
PerlIO *
Perl_my_popen(pTHX_ char *cmd, char *mode)
{
#endif /* defined OS2 */
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
- sv_setiv(GvSV(tmpgv), getpid());
+ sv_setiv(GvSV(tmpgv), PerlProc_getpid());
PL_forkprocess = 0;
hv_clear(PL_pidstatus); /* we have no children */
return Nullfp;
oldsig = PerlProc_signal(signo, sig_trap);
PerlProc_signal(signo, oldsig);
if (sig_trapped)
- PerlProc_kill(getpid(), signo);
+ PerlProc_kill(PerlProc_getpid(), signo);
return oldsig;
}
#endif /* !HAS_SIGACTION */
/* VMS' my_pclose() is in VMS.c; same with OS/2 */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
}
#endif /* !DOSISH */
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
if (!pid)
return -1;
if (pid > 0) {
- sprintf(spid, "%d", pid);
+ sprintf(spid, "%"IVdf, (IV)pid);
svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
if (svp && *svp != &PL_sv_undef) {
*statusp = SvIVX(*svp);
pid = atoi(hv_iterkey(entry,(I32*)statusp));
sv = hv_iterval(PL_pidstatus,entry);
*statusp = SvIVX(sv);
- sprintf(spid, "%d", pid);
+ sprintf(spid, "%"IVdf, (IV)pid);
(void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
return pid;
}
register SV *sv;
char spid[TYPE_CHARS(int)];
- sprintf(spid, "%d", pid);
+ sprintf(spid, "%"IVdf, (IV)pid);
sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = status;
}
#endif
+#ifdef MACOS_TRADITIONAL
+ if (dosearch && !strchr(scriptname, ':') &&
+ (s = PerlEnv_getenv("Commands")))
+#else
if (dosearch && !strchr(scriptname, '/')
#ifdef DOSISH
&& !strchr(scriptname, '\\')
#endif
- && (s = PerlEnv_getenv("PATH"))) {
+ && (s = PerlEnv_getenv("PATH")))
+#endif
+ {
bool seen_dot = 0;
PL_bufend = s + strlen(s);
while (s < PL_bufend) {
+#ifdef MACOS_TRADITIONAL
+ s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, PL_bufend,
+ ',',
+ &len);
+#else
#if defined(atarist) || defined(DOSISH)
for (len = 0; *s
# ifdef atarist
':',
&len);
#endif /* ! (atarist || DOSISH) */
+#endif /* MACOS_TRADITIONAL */
if (s < PL_bufend)
s++;
if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
continue; /* don't search dir with too-long name */
+#ifdef MACOS_TRADITIONAL
+ if (len && tmpbuf[len - 1] != ':')
+ tmpbuf[len++] = ':';
+#else
if (len
#if defined(atarist) || defined(__MINT__) || defined(DOSISH)
&& tmpbuf[len - 1] != '/'
tmpbuf[len++] = '/';
if (len == 2 && tmpbuf[0] == '.')
seen_dot = 1;
+#endif
(void)strcpy(tmpbuf + len, scriptname);
#endif /* !VMS */
continue;
if (S_ISREG(PL_statbuf.st_mode)
&& cando(S_IRUSR,TRUE,&PL_statbuf)
-#ifndef DOSISH
+#if !defined(DOSISH) && !defined(MACOS_TRADITIONAL)
&& cando(S_IXUSR,TRUE,&PL_statbuf)
#endif
)
Zero(thr, 1, struct perl_thread);
#endif
- PL_protect = MEMBER_TO_FPTR(Perl_default_protect);
-
thr->oursv = sv;
init_stacks();
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
- /* 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 {}!
- See comments in scope.h
- Initialize top entry (as in perl.c for main thread)
- */
- PL_start_env.je_prev = NULL;
- PL_start_env.je_ret = -1;
- PL_start_env.je_mustcatch = TRUE;
- PL_top_env = &PL_start_env;
+ JMPENV_BOOTSTRAP;
PL_in_eval = EVAL_NULL; /* ~(EVAL_INEVAL|EVAL_WARNONLY|EVAL_KEEPERR) */
PL_restartop = 0;
PL_ofs = savepvn(t->Tofs, PL_ofslen);
PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
PL_chopset = t->Tchopset;
- PL_formtarget = newSVsv(t->Tformtarget);
PL_bodytarget = newSVsv(t->Tbodytarget);
PL_toptarget = newSVsv(t->Ttoptarget);
+ if (t->Tformtarget == t->Ttoptarget)
+ PL_formtarget = PL_toptarget;
+ else
+ PL_formtarget = PL_bodytarget;
/* Initialise all per-thread SVs that the template thread used */
svp = AvARRAY(t->threadsv);
av_store(thr->threadsv, i, sv);
sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1);
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
+ "new_struct_thread: copied threadsv %"IVdf" %p->%p\n",
+ (IV)i, t, thr));
}
}
thr->threadsvp = AvARRAY(thr->threadsv);
* 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 */
+# ifdef WIN32
+# define PERL_FILE_IS_ABSOLUTE(f) \
+ (*(f) == '/' \
+ || ((f)[0] && (f)[1] == ':') /* drive name */ \
+ || ((f)[0] == '\\' && (f)[1] == '\\')) /* UNC path */
+# else /* !WIN32 */
+# ifdef DOSISH
+# define PERL_FILE_IS_ABSOLUTE(f) \
+ (*(f) == '/' \
+ || ((f)[0] && (f)[1] == ':')) /* drive name */
+# else /* !DOSISH */
+# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/')
+# endif /* DOSISH */
+# endif /* WIN32 */
+#endif /* VMS */
=head1 AUTHORS
Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
-by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
+by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
{
my ( $backend, $generated_file, $file, $final_output ) = @_;
my $return;
+ my $output_switch = "o";
local($") = " -I";
print GENFILE "#!$^X\n" if @_ == 3;
print GENFILE "use ByteLoader $ByteLoader::VERSION;\n";
+
+ $output_switch ="a";
}
close(GENFILE);
chomp $stash;
_print( "$^X -I@INC -MO=$backend,$stash $file\n", 36);
- $return = _run("$^X -I@INC -MO=$backend,$stash,-o$generated_file $file", 9);
+ $return = _run("$^X -I@INC -MO=$backend,$stash,-$output_switch$generated_file $file", 9);
$return;
}
else # compiling a shared object
_print(
"$^X -I@INC -MO=$backend,-m$final_output $file\n", 36);
$return =
- _run("$^X -I@INC -MO=$backend,-m$final_output,-o$generated_file $file ", 9);
+ _run("$^X -I@INC -MO=$backend,-m$final_output,-$output_switch$generated_file $file ", 9);
$return;
}
}
my $me = $0; # Editing $0 is unportable
$me =~ s,.*/,,;
die <<EOF;
-Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
$me -f PerlFunc
$me -q FAQKeywords
(-t is the default on win32)
-u Display unformatted pod text
-m Display module's file in its entirety
+ -n Specify replacement for nroff
-l Display the module's file name
-F Arguments are file names, not modules
-v Verbosely describe what's going on
}
!NO!SUBS!
-my $getopts = "mhtluvriFf:Xq:";
+my $getopts = "mhtluvriFf:Xq:n:";
print OUT <<"!GET!OPTS!";
use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
print OUT <<'!NO!SUBS!';
usage if $opt_h;
+$opt_n = "nroff" if !$opt_n;
my $podidx;
if ($opt_X) {
close OUT;
}
elsif (not $opt_u) {
- my $cmd = "pod2man --lax $file | nroff -man";
+ my $cmd = "pod2man --lax $_ | $opt_n -man";
$cmd .= " | col -x" if $^O =~ /hpux/;
my $rslt = `$cmd`;
$rslt = filter_nroff($rslt) if $filter;
# Robin Barker <rmb1@cise.npl.co.uk>
# -strict, -w cleanups
# Version 1.13: Fri Feb 27 16:20:50 EST 1997
-# Gurusamy Sarathy <gsar@umich.edu>
+# Gurusamy Sarathy <gsar@activestate.com>
# -doc tweaks for -F and -X options
# Version 1.12: Sat Apr 12 22:41:09 EST 1997
-# Gurusamy Sarathy <gsar@umich.edu>
+# Gurusamy Sarathy <gsar@activestate.com>
# -various fixes for win32
# Version 1.11: Tue Dec 26 09:54:33 EST 1995
# Kenneth Albanowski <kjahds@kjahds.com>
!GROK!THIS!
# Descrip.MMS for perl5 on VMS
-# Last revised 18-Oct-1998 by Charles Bailey bailey@newman.upenn.edu
+# Last revised 8-Nov-1999 by Craig Berry craig.berry@metamor.com
+# Revised 18-Oct-1998 by Charles Bailey bailey@newman.upenn.edu
#
#: This file uses MMS syntax, and can be processed using DEC's MMS product,
#: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to
obj1 = globals$(O) gv$(O) hv$(O) mg$(O) miniperlmain$(O) op$(O) perl$(O)
obj2 = perlio$(O) perly$(O) pp$(O) pp_ctl$(O) pp_hot$(O) pp_sys$(O)
obj3 = regcomp$(O) regexec$(O) run$(O) scope$(O) sockadapt$(O) sv$(O)
-obj4 = taint$(O) toke$(O) universal$(O) utf8$(O) util$(O) vms$(O)
+obj4 = taint$(O) toke$(O) universal$(O) utf8$(O) util$(O) vms$(O) xsutils$(O)
obj = $(obj0) $(obj1) $(obj2) $(obj3) $(obj4)
-h0 = $(SOCKH) av.h cc_runtime.h config.h cop.h cv.h embed.h embedvar.h
-h1 = extern.h $(THREADH) form.h gv.h handy.h hv.h intern.h intrpvar.h
-h2 = iperlsys.h keywords.h mg.h nostdio.h op.h opcode.h patchlevel.h perl.h
-h3 = perlio.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h
-h4 = regcomp.h regexp.h regnodes.h scope.h sv.h thrdvar.h
-h5 = thread.h utf8.h util.h vmsish.h warnings.h xsub.h opnames.h
+h0 = $(SOCKH) $(THREADH) av.h cc_runtime.h config.h cop.h cv.h embed.h
+h1 = embedvar.h extern.h form.h gv.h handy.h hv.h intern.h intrpvar.h
+h2 = iperlsys.h mg.h nostdio.h objxsub.h op.h opcode.h opnames.h
+h3 = patchlevel.h perl.h perlio.h perlsdio.h perlvars.h perly.h pp.h
+h4 = pp_proto.h proto.h regexp.h scope.h sv.h thrdvar.h thread.h utf8.h
+h5 = util.h vmsish.h warnings.h xsub.h
+h6 = regcomp.h regcomp.h
+h7 = keywords.h
h = $(h0) $(h1) $(h2) $(h3) $(h4) $(h5)
+allh = $(h) $(h6) $(h7)
ac0 = $(SOCKARCH) $(ARCHCORE)av.h $(ARCHCORE)cc_runtime.h
ac1 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h
perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod
@ $(NOOP)
-archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(ac10) $(acs) $(acth) $(ARCHAUTO)time.stamp
+archcorefiles : $(ac) $(acth) $(ARCHAUTO)time.stamp
@ $(NOOP)
miniperl : $(DBG)miniperl$(E)
$(DBG)libperl$(OLB) : $(obj)
@ If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
- Library/Object/Replace $(MMS$TARGET) $(obj1)
- Library/Object/Replace $(MMS$TARGET) $(obj2)
- Library/Object/Replace $(MMS$TARGET) $(obj3)
+ Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl
$(MINIPERL) [.VMS]Writemain.pl "$(EXT)"
# The following files are built in one go by gen_shrfls.pl:
# perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP
# perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
-# The song and dance with gen_shrfls.opt accomodates DCL's 255 character
+# The song and dance with gen_shrfls.opt accommodates DCL's 255 character
# line length limit.
.ifdef PIPES_BROKEN
# This is a backup target used only with older versions of the DECCRTL which
@ If F$Search("hash$(O)").nes."" Then Rename/NoLog hash$(O),str$(O),util$(O),walk$(O) [.x2p]
Link $(LINKFLAGS) /Exe=$(MMS$TARGET) $(MMS$SOURCE_LIST) $(CRTLOPTS)
-# Accomodate buggy cpp in some version of DECC, which chokes on illegal
+# Accommodate buggy cpp in some version of DECC, which chokes on illegal
# filespec "y.tab.c", and broken gcc cpp, which doesn't start #include ""
# search in same dir as source file
[.x2p]a2p$(O) : [.x2p]a2p.c [.x2p]a2py.c [.x2p]INTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h config.h handy.h vmsish.h $(SOCKH) $(MINIPERL_EXE)
.ifdef LINK_ONLY
.else
-perly$(O) : perly.c, perly.h, $(h)
+perly$(O) : perly.c, perly.h, $(allh)
.endif
[.t.lib]vmsfspec.t : [.vms.ext]filespec.t
# $(CC) $(CORECFLAGS) $(MMS$SOURCE)
# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
.ifdef SOCKET
-$(SOCKOBJ) : $(SOCKC) extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+$(SOCKOBJ) : $(SOCKC) $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
.endif
-av$(O) : av.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+av$(O) : av.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-deb$(O) : deb.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+deb$(O) : deb.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-doio$(O) : doio.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+doio$(O) : doio.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-doop$(O) : doop.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+doop$(O) : doop.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-dump$(O) : dump.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h regcomp.h regnodes.h
+dump$(O) : dump.c $(h) $(h6)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-globals$(O) : globals.c intern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+globals$(O) : globals.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-gv$(O) : gv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+gv$(O) : gv.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-hv$(O) : hv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+hv$(O) : hv.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-mg$(O) : mg.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+mg$(O) : mg.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-miniperlmain$(O) : miniperlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+miniperlmain$(O) : miniperlmain.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-op$(O) : op.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+op$(O) : op.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-perl$(O) : perl.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h intrpvar.h thrdvar.h
+perl$(O) : perl.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-perlio$(O) : perlio.c config.h extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+perlio$(O) : perlio.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-perlmain$(O) : perlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+perlmain$(O) : perlmain.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-perly$(O) : perly.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+perly$(O) : perly.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-pp$(O) : pp.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+pp$(O) : pp.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-pp_ctl$(O) : pp_ctl.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+pp_ctl$(O) : pp_ctl.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-pp_hot$(O) : pp_hot.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+pp_hot$(O) : pp_hot.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-pp_sys$(O) : pp_sys.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+pp_sys$(O) : pp_sys.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-regcomp$(O) : regcomp.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h intern.h regcomp.h regnodes.h
+regcomp$(O) : regcomp.c $(h) $(h6)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-regexec$(O) : regexec.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h regcomp.h regnodes.h
+regexec$(O) : regexec.c $(h) $(h6)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-run$(O) : run.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+run$(O) : run.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-scope$(O) : scope.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+scope$(O) : scope.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-sv$(O) : sv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+sv$(O) : sv.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-taint$(O) : taint.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+taint$(O) : taint.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-toke$(O) : toke.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h keywords.h
+toke$(O) : toke.c $(h) $(h7)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-universal$(O) : universal.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h xsub.h
+universal$(O) : universal.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-utf8$(O) : utf8.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+utf8$(O) : utf8.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-util$(O) : util.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h
+util$(O) : util.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-vms$(O) : vms.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h xsub.h
+vms$(O) : vms.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
[.x2p]hash$(O) : [.x2p]hash.c [.x2p]EXTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h vmsish.h $(SOCKH)
#line 338 "perly.y"
{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
- || strEQ(name, "INIT"))
+ || strEQ(name, "STOP") || strEQ(name, "INIT"))
CvSPECIAL_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
}
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
$ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE")
$!
$! ##ADD NEW CONSTANTS HERE##
+$ perl_d_fs_data_s = "undef"
+$ perl_d_getmnt = "undef"
+$ perl_d_sqrtl = "define"
+$ perl_d_statfs_f_flags = "undef"
+$ perl_d_statfs_s = "undef"
+$ perl_d_ustat = "undef"
+$ perl_i_sysstatfs = "undef"
+$ perl_i_sysvfs = "undef"
+$ perl_i_ustat = "undef"
$ perl_d_llseek="undef"
$ perl_d_madvise="undef"
$ perl_selectminbits=32
$ IF use_64bit .eqs. "Y"
$ THEN
$ perl_use64bits = "define"
+$ perl_uselargefiles = "define"
+$ perl_uselongdouble = "define"
+$ perl_usemorebits = "define"
$ ELSE
$ perl_use64bits = "undef"
+$ perl_uselargefiles = "undef"
+$ perl_uselongdouble = "undef"
+$ perl_usemorebits = "undef"
$ ENDIF
$ perl_d_drand48proto = "define"
$ perl_libpth="/sys$share /sys$library"
$ perl_sPRIu64 = """Lu"""
$ perl_sPRIo64 = """Lo"""
$ perl_sPRIx64 = """Lx"""
+$ perl_d_quad = "define"
+$ perl_quadtype = "long long"
+$ perl_uquadtype = "unsigned long long"
$ ELSE
$ perl_d_PRIfldbl = "undef"
$ perl_d_PRIgldbl = "undef"
$ perl_sPRIu64 = ""
$ perl_sPRIo64 = ""
$ perl_sPRIx64 = ""
+$ perl_d_quad = "undef"
$ ENDIF
$!
-$!
$! Now some that we build up
$!
$ LocalTime = f$time()
$ OPEN/READ TEMPOUT [-.uu]tempout.lis
$ READ TEMPOUT line
$ CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
$
$ perl_cpp_stuff=line
$ WRITE_RESULT "cpp_stuff is ''perl_cpp_stuff'"
$ else
$ link temp.obj
$ endif
-$! link temp.obj
$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
$ DEASSIGN SYS$OUTPUT
$ DEASSIGN SYS$ERROR
$ OPEN/READ TEMPOUT [-.uu]tempout.lis
$ READ TEMPOUT line
$ CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
$
$ perl_doublesize=line
$ WRITE_RESULT "doublesize is ''perl_doublesize'"
$ OPEN/READ TEMPOUT [-.uu]tempout.lis
$ READ TEMPOUT line
$ CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
$
$ perl_longdblsize=line
$ perl_d_longdbl="define"
$ OPEN/READ TEMPOUT [-.uu]tempout.lis
$ READ TEMPOUT line
$ CLOSE TEMPOUT
-$
+$ DELETE/NOLOG [-.uu]tempout.lis;
$ perl_longlongsize=line
$ perl_d_longlong="define"
$ ENDIF
$ WRITE_RESULT "longlongsize is ''perl_longlongsize'"
$ WRITE_RESULT "d_longlong is ''perl_d_longlong'"
$!
-$! Check for int size
-$!
-$ OS
-$ WS "#ifdef __DECC
-$ WS "#include <stdlib.h>
-$ WS "#endif
-$ WS "#include <stdio.h>
-$ WS "int main()
-$ WS "{"
-$ WS "printf(""%d\n"", sizeof(int));
-$ WS "exit(0);
-$ WS "}"
-$ CS
-$ DEFINE SYS$ERROR _NLA0:
-$ DEFINE SYS$OUTPUT _NLA0:
-$ on error then continue
-$ on warning then continue
-$ 'Checkcc' temp.c
-$ If (Needs_Opt.eqs."Yes")
-$ THEN
-$ link temp.obj,temp.opt/opt
-$ else
-$ link temp.obj
-$ endif
-$ If (Needs_Opt.eqs."Yes")
-$ THEN
-$ link temp.obj,temp.opt/opt
-$ else
-$ link temp.obj
-$ endif
-$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ DEFINE SYS$ERROR TEMPOUT
-$ DEFINE SYS$OUTPUT TEMPOUT
-$ mcr []temp
-$ CLOSE TEMPOUT
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ OPEN/READ TEMPOUT [-.uu]tempout.lis
-$ READ TEMPOUT line
-$ CLOSE TEMPOUT
-$
-$ perl_intsize=line
-$ WRITE_RESULT "intsize is ''perl_intsize'"
-$!
-$! Check for short size
-$!
-$ OS
-$ WS "#ifdef __DECC
-$ WS "#include <stdlib.h>
-$ WS "#endif
-$ WS "#include <stdio.h>
-$ WS "int main()
-$ WS "{"
-$ WS "printf(""%d\n"", sizeof(short));
-$ WS "exit(0);
-$ WS "}"
-$ CS
-$ DEFINE SYS$ERROR _NLA0:
-$ DEFINE SYS$OUTPUT _NLA0:
-$ on error then continue
-$ on warning then continue
-$ 'Checkcc' temp.c
-$ If (Needs_Opt.eqs."Yes")
-$ THEN
-$ link temp.obj,temp.opt/opt
-$ else
-$ link temp.obj
-$ endif
-$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ DEFINE SYS$ERROR TEMPOUT
-$ DEFINE SYS$OUTPUT TEMPOUT
-$ mcr []temp
-$ CLOSE TEMPOUT
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ OPEN/READ TEMPOUT [-.uu]tempout.lis
-$ READ TEMPOUT line
-$ CLOSE TEMPOUT
-$
-$ perl_shortsize=line
-$ WRITE_RESULT "shortsize is ''perl_shortsize'"
-$!
-$! Check for long size
-$!
-$ OS
-$ WS "#ifdef __DECC
-$ WS "#include <stdlib.h>
-$ WS "#endif
-$ WS "#include <stdio.h>
-$ WS "int main()
-$ WS "{"
-$ WS "int foo;
-$ WS "foo = sizeof(long);
-$ WS "printf(""%d\n"", foo);
-$ WS "exit(0);
-$ WS "}"
-$ CS
-$ DEFINE SYS$ERROR _NLA0:
-$ DEFINE SYS$OUTPUT _NLA0:
-$ on error then continue
-$ on warning then continue
-$ 'Checkcc' temp.c
-$ If (Needs_Opt.eqs."Yes")
-$ THEN
-$ link temp.obj,temp.opt/opt
-$ else
-$ link temp.obj
-$ endif
-$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ DEFINE SYS$ERROR TEMPOUT
-$ DEFINE SYS$OUTPUT TEMPOUT
-$ mcr []temp
-$ CLOSE TEMPOUT
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ OPEN/READ TEMPOUT [-.uu]tempout.lis
-$ READ TEMPOUT line
-$ CLOSE TEMPOUT
-$
-$ perl_longsize=line
-$ WRITE_RESULT "longsize is ''perl_longsize'"
-$!
$! Check the prototype for getgid
$!
$ OS
$ WS "exit(0);
$ WS "}"
$ CS
-$! copy temp.c sys$output
-$!
-$ DEFINE SYS$ERROR _NLA0:
-$ DEFINE SYS$OUTPUT _NLA0:
-$ ON ERROR THEN CONTINUE
-$ ON WARNING THEN CONTINUE
-$ 'Checkcc' temp.c
-$ If (Needs_Opt.eqs."Yes")
-$ THEN
-$ link temp.obj,temp.opt/opt
-$ else
-$ link temp.obj
-$ endif
-$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ DEFINE SYS$ERROR TEMPOUT
-$ DEFINE SYS$OUTPUT TEMPOUT
-$ mcr []temp
-$ CLOSE TEMPOUT
-$ DEASSIGN SYS$OUTPUT
-$ DEASSIGN SYS$ERROR
-$ OPEN/READ TEMPOUT [-.uu]tempout.lis
-$ READ TEMPOUT line
-$ CLOSE TEMPOUT
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ ON ERROR THEN CONTINUE
+$ ON WARNING THEN CONTINUE
+$ 'Checkcc' temp.c
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ ELSE
+$ link temp.obj
+$ ENDIF
+$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ DEFINE SYS$ERROR TEMPOUT
+$ DEFINE SYS$OUTPUT TEMPOUT
+$ mcr []temp.exe
+$ CLOSE TEMPOUT
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ OPEN/READ TEMPOUT [-.uu]tempout.lis
+$ READ TEMPOUT line
+$ CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
$
$ perl_ptrsize=line
$ WRITE_RESULT "ptrsize is ''perl_ptrsize'"
$!
-$!
$! Check rand48 and its ilk
$!
$ OS
$ WS "exit(0);
$ WS "}"
$ CS
-$! copy temp.c sys$output
$!
$ DEFINE SYS$ERROR _NLA0:
$ DEFINE SYS$OUTPUT _NLA0:
$ perl_vms_cc_type="vaxc"
$ ENDIF
$!
-$!
$! Sockets?
$ if ("''Has_Socketshr'".EQS."T").OR.("''Has_Dec_C_Sockets'".EQS."T")
$ THEN
$ perl_d_pthreads_created_joinable="undef"
$ ENDIF
$!
+$! new (5.005_62++) typedefs for primitives
+$!
+$ perl_ivtype="long"
+$ perl_uvtype="unsigned long"
+$ perl_i8type="char"
+$ perl_u8type="unsigned char"
+$ perl_i16type="short"
+$ perl_u16type="unsigned short"
+$ perl_i32type="int"
+$ perl_u32type="unsigned int"
+$ perl_i64type="long"
+$ perl_u64type="unsigned long"
+$ perl_nvtype="double"
+$!
+$ GOTO beyond_type_size_check
+$!
+$type_size_check:
+$!
+$! Check for type sizes
+$!
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <stdio.h>
+$ WS "int main()
+$ WS "{"
+$ WS "printf(""%d\n"", sizeof(''type'));"
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ ON ERROR THEN CONTINUE
+$ ON WARNING THEN CONTINUE
+$ 'Checkcc' temp.c
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ ELSE
+$ link temp.obj
+$ ENDIF
+$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ DEFINE SYS$ERROR TEMPOUT
+$ DEFINE SYS$OUTPUT TEMPOUT
+$ mcr []temp.exe
+$ CLOSE TEMPOUT
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ OPEN/READ TEMPOUT [-.uu]tempout.lis
+$ READ TEMPOUT line
+$ CLOSE TEMPOUT
+$ DELETE/NOLOG [-.uu]tempout.lis;
+$ WRITE_RESULT "''size_name' is ''line'"
+$ DS
+$ RETURN
+$!
+$beyond_type_size_check:
+$!
+$ line = ""
+$ type = "''perl_ivtype'"
+$ size_name = "ivsize"
+$ gosub type_size_check
+$ perl_ivsize="''line'"
+$ IF type .eqs. "long"
+$ THEN perl_longsize = "''line'"
+$ ELSE
+$ type = "long"
+$ size_name = "longsize"
+$ gosub type_size_check
+$ perl_longsize="''line'"
+$ ENDIF
+$
+$ type = "''perl_uvtype'"
+$ size_name = "uvsize"
+$ gosub type_size_check
+$ perl_uvsize="''line'"
+$
+$ type = "''perl_i8type'"
+$ size_name = "i8size"
+$ gosub type_size_check
+$ perl_i8size="''line'"
+$
+$ type = "''perl_u8type'"
+$ size_name = "u8size"
+$ gosub type_size_check
+$ perl_u8size="''line'"
+$
+$ type = "''perl_i16type'"
+$ size_name = "i16size"
+$ gosub type_size_check
+$ perl_i16size="''line'"
+$ IF type .eqs. "short"
+$ THEN perl_shortsize="''line'"
+$ ELSE
+$ type = "''perl_i16type'"
+$ size_name = "shortsize"
+$ gosub type_size_check
+$ perl_shortsize="''line'"
+$ ENDIF
+$
+$ type = "''perl_u16type'"
+$ size_name = "u16size"
+$ gosub type_size_check
+$ perl_u16size="''line'"
+$
+$ type = "''perl_i32type'"
+$ size_name = "i32size"
+$ gosub type_size_check
+$ perl_i32size="''line'"
+$ IF type .eqs. "int"
+$ THEN perl_intsize="''perl_i32size'"
+$ ELSE
+$ type = "int"
+$ size_name = "intsize"
+$ gosub type_size_check
+$ perl_intsize="''line'"
+$ ENDIF
+$
+$ type = "''perl_u32type'"
+$ size_name = "u32size"
+$ gosub type_size_check
+$ perl_u32size="''line'"
+$
+$ type = "''perl_i64type'"
+$ size_name = "i64size"
+$ gosub type_size_check
+$ perl_i64size="''line'"
+$
+$ type = "''perl_u64type'"
+$ size_name = "u64size"
+$ gosub type_size_check
+$ perl_u64size="''line'"
+$!
+$ perl_ivdformat="""ld"""
+$ perl_uvuformat="""lu"""
+$ perl_uvoformat="""lo"""
+$ perl_uvxformat="""lx"""
$!
$! Finally the composite ones. All config
$ perl_installarchlib="''perl_prefix':[lib.''perl_arch'.''localperlver']"
$ WC "d_longdbl='" + perl_d_longdbl + "'"
$ WC "longdblsize='" + perl_longdblsize + "'"
$ WC "d_longlong='" + perl_d_longlong + "'"
+$ WC "uselonglong='" + perl_d_longlong + "'"
$ WC "longlongsize='" + perl_longlongsize + "'"
$ WC "d_mkstemp='" + perl_d_mkstemp + "'"
$ WC "d_setvbuf='" + perl_d_setvbuf + "'"
$ WC "sPRIo64='" + perl_sPRIo64 + "'"
$ WC "sPRIx64='" + perl_sPRIx64 + "'"
$ WC "d_llseek='" + perl_d_llseek + "'"
+$ WC "uselargefiles='" + perl_uselargefiles + "'"
+$ WC "uselongdouble='" + perl_uselongdouble + "'"
+$ WC "usemorebits='" + perl_usemorebits + "'"
+$ WC "d_quad='" + perl_d_quad + "'"
+$ if (use_64bit .eqs. "Y")
+$ THEN
+$ WC "quadtype='" + perl_quadtype + "'"
+$ WC "uquadtype='" + perl_uquadtype + "'"
+$ ENDIF
+$ WC "d_fs_data_s='" + perl_d_fs_data_s + "'"
+$ WC "d_getmnt='" + perl_d_getmnt + "'"
+$ WC "d_sqrtl='" + perl_d_sqrtl + "'"
+$ WC "d_statfs_f_flags='" + perl_d_statfs_f_flags + "'"
+$ WC "d_statfs_s='" + perl_d_statfs_s + "'"
+$ WC "d_ustat='" + perl_d_ustat + "'"
+$ WC "i_sysstatfs='" + perl_i_sysstatfs + "'"
+$ WC "i_sysvfs='" + perl_i_sysvfs + "'"
+$ WC "i_ustat='" + perl_i_ustat + "'"
+$ WC "ivtype='" + perl_ivtype + "'"
+$ WC "uvtype='" + perl_uvtype + "'"
+$ WC "i8type='" + perl_i8type + "'"
+$ WC "i16type='" + perl_i16type + "'"
+$ WC "u8type='" + perl_u8type + "'"
+$ WC "u16type='" + perl_u16type + "'"
+$ WC "i32type='" + perl_i32type + "'"
+$ WC "u32type='" + perl_u32type + "'"
+$ WC "i64type='" + perl_i64type + "'"
+$ WC "u64type='" + perl_u64type + "'"
+$ WC "nvtype='" + perl_nvtype + "'"
+$ WC "ivsize='" + perl_ivsize + "'"
+$ WC "uvsize='" + perl_uvsize + "'"
+$ WC "i8size='" + perl_i8size + "'"
+$ WC "u8size='" + perl_u8size + "'"
+$ WC "i16size='" + perl_i16size + "'"
+$ WC "u16size='" + perl_u16size + "'"
+$ WC "i32size='" + perl_i32size + "'"
+$ WC "u32size='" + perl_u32size + "'"
+$ WC "i64size='" + perl_i64size + "'"
+$ WC "u64size='" + perl_u64size + "'"
+$ WC "ivdformat='" + perl_ivdformat + "'"
+$ WC "uvuformat='" + perl_uvuformat + "'"
+$ WC "uvoformat='" + perl_uvoformat + "'"
+$ WC "uvxformat='" + perl_uvxformat + "'"
$!
$! ##WRITE NEW CONSTANTS HERE##
$!
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
* subset of the applicable information.
*/
-/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
-I32
-Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t *statbufp)
+bool
+Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
{
if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
else {
/*}}}*/
-/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/
+/*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/
I32
-cando_by_name(I32 bit, I32 effective, char *fname)
+cando_by_name(I32 bit, Uid_t effective, char *fname)
{
static char usrname[L_cuserid];
static struct dsc$descriptor_s usrdsc =
int my_sigismember (sigset_t *, int);
int my_sigprocmask (int, sigset_t *, sigset_t *);
#endif
-I32 cando_by_name (I32, I32, char *);
+I32 cando_by_name (I32, Uid_t, char *);
int flex_fstat (int, Stat_t *);
int flex_stat (const char *, Stat_t *);
int trim_unixpath (char *, char*, int);
#undef HAS_NTOHL
#endif
-#define TMPPATH "sys$scratch:perl-eXXXXXX"
-
#endif /* __vmsish_h_included */
#ifndef SIGILL
# define SIGILL 6 /* blech */
#endif
-#define ABORT() kill(getpid(),SIGABRT);
+#define ABORT() kill(PerlProc_getpid(),SIGABRT);
/*
* fwrite1() should be a routine with the same calling sequence as fwrite(),
#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
#define WARN_STD Nullsv
-#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */
-#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */
+#define WARN_ALL (Nullsv+1) /* use warnings 'all' */
+#define WARN_NONE (Nullsv+2) /* no warnings 'all' */
#define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \
(x) == WARN_NONE)
#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
#define WARN_STD Nullsv
-#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */
-#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */
+#define WARN_ALL (Nullsv+1) /* use warnings 'all' */
+#define WARN_NONE (Nullsv+2) /* no warnings 'all' */
#define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \
(x) == WARN_NONE)
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER = \5.00562
+INST_VER = \5.00563
#
# Comment this out if you DON'T want your perl installation to have
#USE_OBJECT = define
#
+# XXX WARNING! This option currently undergoing changes. May be broken.
+#
+# Beginnings of interpreter cloning/threads: still rather rough, fails
+# tests. This should be enabled to get the fork() emulation. Do not
+# enable unless you know what you're doing!
+#
+#USE_ITHREADS = define
+
+#
+# uncomment to enable the implicit "host" layer for all system calls
+# made by perl. This is needed and auto-enabled by USE_OBJECT above.
+#
+#USE_IMP_SYS = define
+
+#
# uncomment one of the following lines if you are using either
# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98)
#
# and follow the directions in the package to install.
#
#USE_PERLCRT = define
+#BUILD_FOR_WIN95 = define
#
# uncomment to enable linking with setargv.obj under the Visual C
#BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE
#
-# enable this to test the File::Glob implementation of CORE::glob
+# enable this to disable the File::Glob implementation of CORE::glob
#
-#BUILDOPT = $(BUILDOPT) -DPERL_INTERNAL_GLOB
+#BUILDOPT = $(BUILDOPT) -DPERL_EXTERNAL_GLOB
+
+# Enabling this runs a cloned toplevel interpreter (fails tests)
+#BUILDOPT = $(BUILDOPT) -DTOP_CLONE
-#
# specify semicolon-separated list of extra directories that modules will
# look for libraries (spaces in path names need not be quoted)
#
PERL_MALLOC = undef
USE_THREADS = undef
USE_MULTI = undef
+USE_IMP_SYS = define
!ENDIF
!IF "$(PERL_MALLOC)" == ""
USE_THREADS = undef
!ENDIF
+!IF "$(USE_THREADS)" == "define"
+USE_ITHREADS = undef
+!ENDIF
+
!IF "$(USE_MULTI)" == ""
USE_MULTI = undef
!ENDIF
USE_OBJECT = undef
!ENDIF
+!IF "$(USE_ITHREADS)" == ""
+USE_ITHREADS = undef
+!ENDIF
+
+!IF "$(USE_IMP_SYS)" == ""
+USE_IMP_SYS = undef
+!ENDIF
+
!IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef"
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
+!IF "$(USE_ITHREADS)" != "undef"
+BUILDOPT = $(BUILDOPT) -DUSE_ITHREADS
+!ENDIF
+
+!IF "$(USE_IMP_SYS)" != "undef"
+BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
MINIPERL = ..\miniperl.exe
MINIDIR = .\mini
PERLEXE = ..\perl.exe
+WPERLEXE = ..\wperl.exe
GLOBEXE = ..\perlglob.exe
CONFIGPM = ..\lib\Config.pm
MINIMOD = ..\lib\ExtUtils\Miniperl.pm
..\utils\c2ph \
..\utils\h2xs \
..\utils\perldoc \
- ..\utils\pstruct \
..\utils\perlcc \
..\pod\checkpods \
..\pod\pod2html \
CFGSH_TMPL = config.vc
CFGH_TMPL = config_H.vc
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
PERL95EXE = ..\perl95.exe
!ENDIF
.\include\dirent.h \
.\include\netdb.h \
.\include\sys\socket.h \
- .\win32.h
+ .\win32.h \
+ .\perlhost.h \
+ .\vdir.h \
+ .\vmem.h
CORE_H = $(CORE_NOCFG_H) .\config.h
if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
$(MINICORE_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*F).c
+ $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*F).c
$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c
+# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
+!IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef"
+perllib$(o) : perllib.c
+ $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
+!ENDIF
+
# 1. we don't want to rebuild miniperl.exe when config.h changes
# 2. we don't want to rebuild miniperl.exe with non-default config.h
$(MINI_OBJ) : $(CORE_NOCFG_H)
$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
$(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
$(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+ copy $(PERLEXE) $(WPERLEXE)
+ editbin /subsystem:windows $(WPERLEXE)
copy splittree.pl ..
$(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
perl95.c : runperl.c
copy runperl.c perl95.c
if not exist $(AUTODIR) mkdir $(AUTODIR)
cd $(EXTDIR)\$(*B)
..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL
cd ..\..\win32
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B)
$(XSUBPP) dl_win32.xs > $(*B).c
cd ..\..\win32
-del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
-del /f $(EXTDIR)\DynaLoader\dl_win32.xs
-del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\XSLoader.pm
-del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
cd ..\utils
- -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct dprofpp
+ -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc dprofpp
-del /f *.bat
cd ..\win32
cd ..\x2p
installbare : utils
$(PERLEXE) ..\installperl
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
!ENDIF
+ if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
$(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
-@erase /f config.h
-@erase $(GLOBEXE)
-@erase $(PERLEXE)
+ -@erase $(WPERLEXE)
-@erase $(PERLDLL)
-@erase $(CORE_OBJ)
-rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
--- /dev/null
+;
+; PerlCRT.def
+;
+; Dll export file for PerlCRT.dll
+; this is needed for GCC/Mingw32 builds of Perl, since GCC
+; can't understand MSVC-ish .lib files
+;
+; Created from the output of 'nm PerlCRT.lib | grep "00000000 T"'
+; -- Benjamin Stuhl <sho_pi@hotmail.com> 10-17-1999
+
+EXPORTS
+ wscanf
+ wprintf
+ wctomb
+ wcsxfrm
+ wcstoul
+ wcstombs
+ wcstol
+ wcstok
+ wcstod
+ wcsstr
+ wcsspn
+ wcsrchr
+ wcspbrk
+ wcsncpy
+ wcsncmp
+ wcsncat
+ wcslen
+ wcsftime
+ wcscspn
+ wcscpy
+ wcscoll
+ wcscmp
+ wcschr
+ wcscat
+ vwprintf
+ vswprintf
+ vsprintf
+ vprintf
+ vfwprintf
+ vfprintf
+ ungetwc
+ ungetc
+ towupper
+ towlower
+ toupper
+ tolower
+ tmpnam
+ tmpfile
+ time
+ tanh
+ tan
+ system
+ swscanf
+ swprintf
+ strxfrm
+ strtoul
+ strtol
+ strtok
+ strtod
+ strstr
+ strspn
+ strrchr
+ strpbrk
+ strncpy
+ strncmp
+ strncat
+ strlen
+ strftime
+ strerror
+ strcspn
+ strcpy
+ strcoll
+ strcmp
+ strchr
+ strcat
+ sscanf
+ srand
+ sqrt
+ sprintf
+ sinh
+ sin
+ signal
+ setvbuf
+ setlocale
+ setbuf
+ scanf
+ rewind
+ rename
+ remove
+ realloc
+ rand
+ raise
+ qsort
+ putwchar
+ putwc
+ puts
+ putchar
+ putc
+ printf
+ pow
+ perror
+ modf
+ mktime
+ memset
+ memmove
+ memcpy
+ memcmp
+ memchr
+ mbtowc
+ mbstowcs
+ mblen
+ malloc
+ longjmp
+ log10
+ log
+ localtime
+ localeconv
+ ldiv
+ ldexp
+ labs
+ isxdigit
+ iswxdigit
+ iswupper
+ iswspace
+ iswpunct
+ iswprint
+ iswlower
+ iswgraph
+ iswdigit
+ iswctype
+ iswcntrl
+ iswascii
+ iswalpha
+ iswalnum
+ isupper
+ isspace
+ ispunct
+ isprint
+ islower
+ isleadbyte
+ isgraph
+ isdigit
+ iscntrl
+ isalpha
+ isalnum
+ is_wctype
+ gmtime
+ getwchar
+ getwc
+ gets
+ getenv
+ getchar
+ getc
+ fwscanf
+ fwrite
+ fwprintf
+ ftell
+ fsetpos
+ fseek
+ fscanf
+ frexp
+ freopen
+ free
+ fread
+ fputws
+ fputwc
+ fputs
+ fputc
+ fprintf
+ fopen
+ fmod
+ floor
+ fgetws
+ fgetwc
+ fgets
+ fgetpos
+ fgetc
+ fflush
+ ferror
+ feof
+ fclose
+ fabs
+ exp
+ exit
+ div
+ difftime
+ ctime
+ cosh
+ cos
+ clock
+ clearerr
+ ceil
+ calloc
+ bsearch
+ atol
+ atoi
+ atof
+ atan2
+ atan
+ asin
+ asctime
+ acos
+ abs
+ abort
+ _yn
+ _y1
+ _y0
+ _wutime
+ _wunlink
+ _wtol
+ _wtoi64
+ _wtoi
+ _wtmpnam
+ _wtempnam
+ _wsystem
+ _wstrtime
+ _wstrdate
+ _wstati64
+ _wstat
+ _wsplitpath
+ _wspawnvpe
+ _wspawnvp
+ _wspawnve
+ _wspawnv
+ _wspawnlpe
+ _wspawnlp
+ _wspawnle
+ _wspawnl
+ _wsopen
+ _wsetlocale
+ _wsearchenv
+ _wrmdir
+ _write
+ _wrename
+ _wremove
+ _wputenv
+ _wpopen
+ _wperror
+ _wopen
+ _wmktemp
+ _wmkdir
+ _wmakepath
+ _wgetenv
+ _wgetdcwd
+ _wgetcwd
+ _wfullpath
+ _wfsopen
+ _wfreopen
+ _wfopen
+ _wfindnexti64
+ _wfindnext
+ _wfindfirsti64
+ _wfindfirst
+ _wfdopen
+ _wexecvpe
+ _wexecvp
+ _wexecve
+ _wexecv
+ _wexeclpe
+ _wexeclp
+ _wexecle
+ _wexecl
+ _wctime
+ _wcsupr
+ _wcsset
+ _wcsrev
+ _wcsnset
+ _wcsnicoll
+ _wcsnicmp
+ _wcsncoll
+ _wcslwr
+ _wcsicoll
+ _wcsicmp
+ _wcsdup
+ _wcreat
+ _wchmod
+ _wchdir
+ _wasctime
+ _waccess
+ _vsnwprintf
+ _vsnprintf
+ _utime
+ _unlock
+ _unloaddll
+ _unlink
+ _ungetch
+ _umask
+ _ultow
+ _ultoa
+ _ui64tow
+ _ui64toa
+ _tzset
+ _toupper
+ _tolower
+ _tempnam
+ _telli64
+ _tell
+ _swab
+ _sys_nerr
+ _strupr
+ _strtime
+ _strset
+ _strrev
+ _strnset
+ _strnicoll
+ _strnicmp
+ _strncoll
+ _strlwr
+ _stricoll
+ _stricmp
+ _strerror
+ _strdup
+ _strdate
+ _strcmpi
+ _statusfp
+ _stati64
+ _stat
+ _splitpath
+ _spawnvpe
+ _spawnvp
+ _spawnve
+ _spawnv
+ _spawnlpe
+ _spawnlp
+ _spawnle
+ _spawnl
+ _sopen
+ _snwprintf
+ _snprintf
+ _sleep
+ _setsystime
+ _setmode
+ _setmbcp
+ _setmaxstdio
+ _setjmp3
+ _setjmp
+ _seterrormode
+ _set_sbh_threshold
+ _set_error_mode
+ _seh_longjmp_unwind@4
+ _searchenv
+ _scalb
+ _safe_fprem1
+ _safe_fprem
+ _safe_fdivr
+ _safe_fdiv
+ _rotr
+ _rotl
+ _rmtmp
+ _rmdir
+ _read
+ _putws
+ _putw
+ _putenv
+ _putch
+ _purecall
+ _popen
+ _pipe
+ _pclose
+ _outpw
+ _outpd
+ _outp
+ _open_osfhandle
+ _open
+ _nextafter
+ _msize
+ _mktemp
+ _mkdir
+ _memicmp
+ _memccpy
+ _mbsupr
+ _mbstrlen
+ _mbstok
+ _mbsstr
+ _mbsspnp
+ _mbsspn
+ _mbsset
+ _mbsrev
+ _mbsrchr
+ _mbspbrk
+ _mbsnset
+ _mbsninc
+ _mbsnicoll
+ _mbsnicmp
+ _mbsnextc
+ _mbsncpy
+ _mbsncoll
+ _mbsncmp
+ _mbsnccnt
+ _mbsncat
+ _mbsnbset
+ _mbsnbicoll
+ _mbsnbicmp
+ _mbsnbcpy
+ _mbsnbcoll
+ _mbsnbcnt
+ _mbsnbcmp
+ _mbsnbcat
+ _mbslwr
+ _mbslen
+ _mbsinc
+ _mbsicoll
+ _mbsicmp
+ _mbsdup
+ _mbsdec
+ _mbscspn
+ _mbscpy
+ _mbscoll
+ _mbscmp
+ _mbschr
+ _mbscat
+ _mbsbtype
+ _mbctoupper
+ _mbctombb
+ _mbctolower
+ _mbctokata
+ _mbctohira
+ _mbclen
+ _mbcjmstojis
+ _mbcjistojms
+ _mbccpy
+ _mbbtype
+ _mbbtombc
+ _makepath
+ _ltow
+ _ltoa
+ _lseeki64
+ _lseek
+ _lsearch
+ _lrotr
+ _lrotl
+ _longjmpex
+ _logb
+ _locking
+ _lock
+ _local_unwind2
+ _loaddll
+ _lfind
+ _kbhit
+ _jn
+ _j1
+ _j0
+ _itow
+ _itoa
+ _isnan
+ _ismbstrail
+ _ismbslead
+ _ismbcupper
+ _ismbcsymbol
+ _ismbcspace
+ _ismbcpunct
+ _ismbcprint
+ _ismbclower
+ _ismbclegal
+ _ismbcl2
+ _ismbcl1
+ _ismbcl0
+ _ismbckata
+ _ismbchira
+ _ismbcgraph
+ _ismbcdigit
+ _ismbcalpha
+ _ismbcalnum
+ _ismbbtrail
+ _ismbbpunct
+ _ismbbprint
+ _ismbblead
+ _ismbbkpunct
+ _ismbbkprint
+ _ismbbkana
+ _ismbbkalnum
+ _ismbbgraph
+ _ismbbalpha
+ _ismbbalnum
+ _isctype
+ _isatty
+ _inpw
+ _inpd
+ _inp
+ _initterm
+ _iob
+ _i64tow
+ _i64toa
+ _hypot
+ _HUGE
+ _heapwalk
+ _heapused
+ _heapset
+ _heapmin
+ _heapchk
+ _heapadd
+ _global_unwind2
+ _getws
+ _getw
+ _getsystime
+ _getpid
+ _getmbcp
+ _getmaxstdio
+ _getdrives
+ _getdrive
+ _getdllprocaddr
+ _getdiskfree
+ _getdcwd
+ _getcwd
+ _getche
+ _getch
+ _get_sbh_threshold
+ _get_osfhandle
+ _gcvt
+ _futime
+ _fullpath
+ _ftol
+ _ftime
+ _fstati64
+ _fstat
+ _fsopen
+ _free_osfhnd
+ _fputwchar
+ _fputchar
+ _fpreset
+ _fpieee_flt
+ _fpclass
+ _fmode
+ _flushall
+ _flsbuf
+ _finite
+ _findnexti64
+ _findnext
+ _findfirsti64
+ _findfirst
+ _findclose
+ _fileno
+ _filelengthi64
+ _filelength
+ _filbuf
+ _fgetwchar
+ _fgetchar
+ _fdopen
+ _fcvt
+ _fcloseall
+ _expand
+ _exit
+ _execvpe
+ _execvp
+ _execve
+ _execv
+ _execlpe
+ _execlp
+ _execle
+ _execl
+ _except_handler3
+ _except_handler2
+ _errno
+ _eof
+ _endthreadex
+ _endthread
+ _ecvt
+ _dup2
+ _dup
+ _cwait
+ _cscanf
+ _creat
+ _cputs
+ _cprintf
+ _copysign
+ _controlfp
+ _control87
+ _commit
+ _close
+ _clearfp
+ _chsize
+ _chmod
+ _chgsign
+ _chdrive
+ _chdir
+ _cgets
+ _cexit
+ _callnewh
+ _cabs
+ _c_exit
+ _beginthreadex
+ _beginthread
+ _beep
+ _atoldbl
+ _atoi64
+ _atodbl
+ _assert
+ _amsg_exit
+ _adj_fptan
+ _adj_fprem1
+ _adj_fprem
+ _adj_fpatan
+ _adj_fdivr_m64
+ _adj_fdivr_m32i
+ _adj_fdivr_m32
+ _adj_fdivr_m16i
+ _adj_fdiv_r
+ _adj_fdiv_m64
+ _adj_fdiv_m32i
+ _adj_fdiv_m32
+ _adj_fdiv_m16i
+ _access
+ _abnormal_termination
+ __wgetmainargs
+ __unDName
+ __toascii
+ __threadid
+ __threadhandle
+ __setusermatherr
+ __set_app_type
+ __pxcptinfoptrs
+ __p__wpgmptr
+ __p__winver
+ __p__winminor
+ __p__winmajor
+ __p__wenviron
+ __p__wcmdln
+ __p__tzname
+ __p__timezone
+ __p__pwctype
+ __p__pgmptr
+ __p__pctype
+ __p__osver
+ __p__mbctype
+ __p__mbcasemap
+ __p__iob
+ __p__fmode
+ __p__fileinfo
+ __p__environ
+ __p__dstbias
+ __p__daylight
+ __p__commode
+ __p__amblksiz
+ __p__acmdln
+ __p___winitenv
+ __p___wargv
+ __p___mb_cur_max
+ __p___initenv
+ __p___argv
+ __p___argc
+ __lconv_init
+ __iscsymf
+ __iscsym
+ __isascii
+ __getmainargs
+ __fpecode
+ __doserrno
+ __dllonexit
+ __crtLCMapStringA
+ __crtGetLocaleInfoW
+ __crtCompareStringA
+ __STRINGTOLD
+ __RTtypeid
+ __RTDynamicCast
+ __RTCastToVoid
+ __CxxLongjmpUnwind@4
+ __CxxFrameHandler
+ _XcptFilter
+ _Strftime
+ _Gettnames
+ _Getmonths
+ _Getdays
+ _EH_prolog
+ _CxxThrowException@8
+ _CItanh
+ _CItan
+ _CIsqrt
+ _CIsinh
+ _CIsin
+ _CIpow
+ _CIlog10
+ _CIlog
+ _CIfmod
+ _CIexp
+ _CIcosh
+ _CIcos
+ _CIatan2
+ _CIatan
+ _CIasin
+ _CIacos
+ $I10_OUTPUT
+ _aullshr
+ _aullrem
+ _aulldiv
+ _allshr
+ _allshl
+ _allrem
+ _allmul
+ _alldiv
+ _setdefaultprecision
+ _wsetargv
+ _matherr
+ _setargv
+ __setargv
+ _CRT_INIT@12
+ _DllMainCRTStartup@12
+ _onexit
+ atexit
+ _alloca_probe
+ _chkstk
=head1 AUTHOR
-Gurusamy Sarathy <gsar@umich.edu>
+Gurusamy Sarathy <gsar@activestate.com>
=head1 SEE ALSO
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='5.005'
+apiversion='~PERL_APIVERSION~'
ar='tlib /P128'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
cf_by='nobody'
cf_email='nobody@no.where.net'
cf_time=''
+charsize='1'
chgrp=''
chmod=''
chown=''
d_chroot='undef'
d_chsize='define'
d_closedir='define'
-d_cmsghdr_s='undef'
d_const='define'
d_crypt='undef'
d_csh='undef'
d_fork='undef'
d_fpathconf='undef'
d_fpos64_t='undef'
+d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='define'
d_fstatfs='undef'
d_gethname='define'
d_gethostprotos='define'
d_getlogin='define'
+d_getmnt='undef'
d_getmntent='undef'
d_getnbyaddr='undef'
d_getnbyname='undef'
d_index='undef'
d_inetaton='undef'
d_int64t='undef'
-d_iovec_s='undef'
d_isascii='define'
d_killpg='undef'
d_ldbl_dig='define'
d_lchown='undef'
-d_link='undef'
-d_llseek='undef'
+d_link='define'
d_locconv='define'
d_lockf='undef'
d_longdbl='define'
d_longlong='undef'
d_lstat='undef'
-d_madvise='undef'
d_mblen='define'
d_mbstowcs='define'
d_mbtowc='define'
d_mkdir='define'
d_mkfifo='undef'
d_mktime='define'
-d_mmap='undef'
-d_mprotect='undef'
d_msg='undef'
d_msg_ctrunc='undef'
d_msg_dontroute='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_off64_t='undef'
d_pwcomment='undef'
d_pwexpire='undef'
d_pwgecos='undef'
-d_pwquota='undef'
d_pwpasswd='undef'
+d_pwquota='undef'
+d_quad='undef'
d_readdir='define'
d_readlink='undef'
-d_readv='undef'
-d_recvmsg='undef'
d_rename='define'
d_rewinddir='define'
d_rmdir='define'
d_semctl_semun='undef'
d_semget='undef'
d_semop='undef'
-d_sendmsg='undef'
d_setegid='undef'
d_seteuid='undef'
d_setgrent='undef'
d_sigsetjmp='undef'
d_socket='define'
d_sockpair='undef'
+d_sqrtl='undef'
d_statblks='undef'
-d_statfs='undef'
-d_statfsflags='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
d_statvfs='undef'
d_stdio_cnt_lval='define'
d_stdio_ptr_lval='define'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_ustat='undef'
+d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
d_void_closedir='undef'
d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
-d_writev='undef'
d_xenix='undef'
date='date'
db_hashtype='int'
find='find'
firstmakefile='makefile'
flex=''
+fpossize='4'
fpostype='fpos_t'
freetype='void'
full_ar=''
full_csh=''
full_sed=''
gccversion=''
+gidformat='"d"'
+gidsign='-1'
+gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
grep='grep'
hint='recommended'
hostcat='ypcat hosts'
huge=''
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='__int64'
+i8size='1'
+i8type='char'
i_arpainet='define'
i_bsdioctl=''
i_db='undef'
i_sysfilio='define'
i_sysin='undef'
i_sysioctl='undef'
-i_sysmman='undef'
i_sysmount='undef'
i_sysndir='undef'
i_sysparam='undef'
i_syssecrt='undef'
i_sysselct='undef'
i_syssockio=''
+i_sysstatfs='undef'
i_sysstatvfs='undef'
i_sysstat='define'
i_systime='undef'
i_systypes='define'
i_sysuio='undef'
i_sysun='undef'
+i_sysvfs='undef'
i_syswait='undef'
i_termio='undef'
i_termios='undef'
i_time='define'
i_unistd='undef'
+i_ustat='undef'
i_utime='define'
i_values='undef'
i_varargs='undef'
installsitelib='~INST_TOP~\site~INST_VER~\lib'
installstyle='lib'
installusrbinperl='undef'
+installvendorbin=''
installvendorlib=''
intsize='4'
-known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
ksh=''
large=''
ld='tlink32'
man3direxp='~INST_TOP~~INST_VER~\man\man3'
man3ext='3'
medium=''
-mips=''
mips_type=''
mkdir='mkdir'
-mmaptype='void *'
models='none'
modetype='mode_t'
more='more /e'
nm_so_opt=''
nonxs_ext='Errno'
nroff=''
+nvsize='8'
+nvtype='double'
o_nonblock='O_NONBLOCK'
obj_ext='.obj'
old_pthread_create_joinable=''
privlibexp='~INST_TOP~~INST_VER~\lib'
prototype='define'
ptrsize='4'
+quadcase='5'
+quadtype='__int64'
randbits='15'
randfunc='rand'
randseedtype='unsigned'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
+sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
+sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
sitelib='~INST_TOP~\site~INST_VER~\lib'
sitelibexp='~INST_TOP~\site~INST_VER~\lib'
siteprefix='~INST_TOP~\site~INST_VER~'
tr=''
trnl='\012'
troff=''
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='unsigned __int64'
+u8size='1'
+u8type='unsigned char'
+uidformat='"d"'
uidsign='-1'
+uidsize='4'
uidtype='uid_t'
uname='uname'
uniq='uniq'
+uquadtype='unsigned __int64'
use64bits='undef'
usedl='define'
uselargefiles='undef'
uselongdouble='undef'
+uselonglong='undef'
usemorebits='undef'
usemultiplicity='undef'
usemymalloc='n'
usevfork='false'
usrinc='/usr/include'
uuname=''
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+uvxformat='"lx"'
+vendorbin=''
+vendorbinexp=''
vendorlib=''
vendorlibexp=''
vendorprefix=''
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='5.00562'
+xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='5.00562'
+PERL_APIVERSION='~PERL_APIVERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='5.005'
+apiversion='~PERL_APIVERSION~'
ar='ar'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
cf_by='nobody'
cf_email='nobody@no.where.net'
cf_time=''
+charsize='1'
chgrp=''
chmod=''
chown=''
d_chroot='undef'
d_chsize='define'
d_closedir='define'
-d_cmsghdr_s='undef'
d_const='define'
d_crypt='undef'
d_csh='undef'
d_fork='undef'
d_fpathconf='undef'
d_fpos64_t='undef'
+d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='define'
d_fstatfs='undef'
d_gethname='define'
d_gethostprotos='define'
d_getlogin='define'
+d_getmnt='undef'
d_getmntent='undef'
d_getnbyaddr='undef'
d_getnbyname='undef'
d_index='undef'
d_inetaton='undef'
d_int64t='undef'
-d_iovec_s='undef'
d_isascii='define'
d_killpg='undef'
d_ldbl_dig='define'
d_lchown='undef'
-d_link='undef'
-d_llseek='undef'
+d_link='define'
d_locconv='define'
d_lockf='undef'
d_longdbl='define'
d_longlong='undef'
d_lstat='undef'
-d_madvise='undef'
d_mblen='define'
d_mbstowcs='define'
d_mbtowc='define'
d_mkdir='define'
d_mkfifo='undef'
d_mktime='define'
-d_mmap='undef'
-d_mprotect='undef'
d_msg='undef'
d_msg_ctrunc='undef'
d_msg_dontroute='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_off64_t='undef'
d_pwcomment='undef'
d_pwexpire='undef'
d_pwgecos='undef'
-d_pwquota='undef'
d_pwpasswd='undef'
+d_pwquota='undef'
+d_quad='undef'
d_readdir='define'
d_readlink='undef'
-d_readv='undef'
-d_recvmsg='undef'
d_rename='define'
d_rewinddir='define'
d_rmdir='define'
d_semctl_semun='undef'
d_semget='undef'
d_semop='undef'
-d_sendmsg='undef'
d_setegid='undef'
d_seteuid='undef'
d_setgrent='undef'
d_sigsetjmp='undef'
d_socket='define'
d_sockpair='undef'
+d_sqrtl='undef'
d_statblks='undef'
-d_statfs='undef'
-d_statfsflags='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
d_statvfs='undef'
d_stdio_cnt_lval='define'
d_stdio_ptr_lval='define'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_ustat='undef'
+d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
d_void_closedir='undef'
d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
-d_writev='undef'
d_xenix='undef'
date='date'
db_hashtype='int'
find='find'
firstmakefile='makefile'
flex=''
+fpossize='4'
fpostype='fpos_t'
freetype='void'
full_ar=''
full_csh=''
full_sed=''
gccversion=''
+gidformat='"ld"'
+gidsign='-1'
+gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
grep='grep'
hint='recommended'
hostcat='ypcat hosts'
huge=''
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='long long'
+i8size='1'
+i8type='char'
i_arpainet='define'
i_bsdioctl=''
i_db='undef'
i_sysfilio='define'
i_sysin='undef'
i_sysioctl='undef'
-i_sysmman='undef'
i_sysmount='undef'
i_sysndir='undef'
i_sysparam='undef'
i_syssecrt='undef'
i_sysselct='undef'
i_syssockio=''
+i_sysstatfs='undef'
i_sysstatvfs='undef'
i_sysstat='define'
i_systime='undef'
i_systypes='define'
i_sysuio='undef'
i_sysun='undef'
+i_sysvfs='undef'
i_syswait='undef'
i_termio='undef'
i_termios='undef'
i_time='define'
i_unistd='undef'
+i_ustat='undef'
i_utime='define'
i_values='undef'
i_varargs='undef'
installsitelib='~INST_TOP~\site~INST_VER~\lib'
installstyle='lib'
installusrbinperl='undef'
+installvendorbin=''
installvendorlib=''
intsize='4'
-known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
ksh=''
large=''
ld='gcc'
man3direxp='~INST_TOP~~INST_VER~\man\man3'
man3ext='3'
medium=''
-mips=''
mips_type=''
mkdir='mkdir'
-mmaptype='void *'
models='none'
modetype='mode_t'
more='more /e'
nm_so_opt=''
nonxs_ext='Errno'
nroff=''
+nvsize='8'
+nvtype='double'
o_nonblock='O_NONBLOCK'
obj_ext='.o'
old_pthread_create_joinable=''
privlibexp='~INST_TOP~~INST_VER~\lib'
prototype='define'
ptrsize='4'
+quadcase='5'
+quadtype='long long'
randbits='15'
randfunc='rand'
randseedtype='unsigned'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
+sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
+sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
sitelib='~INST_TOP~\site~INST_VER~\lib'
sitelibexp='~INST_TOP~\site~INST_VER~\lib'
siteprefix='~INST_TOP~\site~INST_VER~'
tr=''
trnl='\012'
troff=''
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='unsigned long long'
+u8size='1'
+u8type='unsigned char'
+uidformat='"ld"'
uidsign='-1'
+uidsize='4'
uidtype='uid_t'
uname='uname'
uniq='uniq'
+uquadtype='unsigned long long'
use64bits='undef'
usedl='define'
uselargefiles='undef'
uselongdouble='undef'
+uselonglong='undef'
usemorebits='undef'
usemultiplicity='define'
usemymalloc='n'
usevfork='false'
usrinc='/usr/include'
uuname=''
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+uvxformat='"lx"'
+vendorbin=''
+vendorbinexp=''
vendorlib=''
vendorlibexp=''
vendorprefix=''
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='5.00562'
+xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='5.00562'
+PERL_APIVERSION='~PERL_APIVERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='5.005'
+apiversion='~PERL_APIVERSION~'
ar='lib'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
cf_by='nobody'
cf_email='nobody@no.where.net'
cf_time=''
+charsize='1'
chgrp=''
chmod=''
chown=''
d_chroot='undef'
d_chsize='define'
d_closedir='define'
-d_cmsghdr_s='undef'
d_const='define'
d_crypt='undef'
d_csh='undef'
d_fork='undef'
d_fpathconf='undef'
d_fpos64_t='undef'
+d_fs_data_s='undef'
d_fseeko='undef'
d_fsetpos='define'
d_fstatfs='undef'
d_gethname='define'
d_gethostprotos='define'
d_getlogin='define'
+d_getmnt='undef'
d_getmntent='undef'
d_getnbyaddr='undef'
d_getnbyname='undef'
d_index='undef'
d_inetaton='undef'
d_int64t='undef'
-d_iovec_s='undef'
d_isascii='define'
d_killpg='undef'
d_ldbl_dig='define'
d_lchown='undef'
-d_link='undef'
-d_llseek='undef'
+d_link='define'
d_locconv='define'
d_lockf='undef'
d_longdbl='define'
d_longlong='undef'
d_lstat='undef'
-d_madvise='undef'
d_mblen='define'
d_mbstowcs='define'
d_mbtowc='define'
d_mkdir='define'
d_mkfifo='undef'
d_mktime='define'
-d_mmap='undef'
-d_mprotect='undef'
d_msg='undef'
d_msg_ctrunc='undef'
d_msg_dontroute='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_off64_t='undef'
d_pwcomment='undef'
d_pwexpire='undef'
d_pwgecos='undef'
-d_pwquota='undef'
d_pwpasswd='undef'
+d_pwquota='undef'
+d_quad='undef'
d_readdir='define'
d_readlink='undef'
-d_readv='undef'
-d_recvmsg='undef'
d_rename='define'
d_rewinddir='define'
d_rmdir='define'
d_semctl_semun='undef'
d_semget='undef'
d_semop='undef'
-d_sendmsg='undef'
d_setegid='undef'
d_seteuid='undef'
d_setgrent='undef'
d_sigsetjmp='undef'
d_socket='define'
d_sockpair='undef'
+d_sqrtl='undef'
d_statblks='undef'
-d_statfs='undef'
-d_statfsflags='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
d_statvfs='undef'
d_stdio_cnt_lval='define'
d_stdio_ptr_lval='define'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_ustat='undef'
+d_vendorbin='undef'
d_vendorlib='undef'
d_vfork='undef'
d_void_closedir='undef'
d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
-d_writev='undef'
d_xenix='undef'
date='date'
db_hashtype='int'
find='find'
firstmakefile='makefile'
flex=''
+fpossize='4'
fpostype='fpos_t'
freetype='void'
full_ar=''
full_csh=''
full_sed=''
gccversion=''
+gidformat='"ld"'
+gidsign='-1'
+gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
grep='grep'
hint='recommended'
hostcat='ypcat hosts'
huge=''
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='__int64'
+i8size='1'
+i8type='char'
i_arpainet='define'
i_bsdioctl=''
i_db='undef'
i_sysfilio='define'
i_sysin='undef'
i_sysioctl='undef'
-i_sysmman='undef'
i_sysmount='undef'
i_sysndir='undef'
i_sysparam='undef'
i_syssecrt='undef'
i_sysselct='undef'
i_syssockio=''
+i_sysstatfs='undef'
i_sysstatvfs='undef'
i_sysstat='define'
i_systime='undef'
i_systypes='define'
i_sysuio='undef'
i_sysun='undef'
+i_sysvfs='undef'
i_syswait='undef'
i_termio='undef'
i_termios='undef'
i_time='define'
i_unistd='undef'
+i_ustat='undef'
i_utime='define'
i_values='undef'
i_varargs='undef'
installsitelib='~INST_TOP~\site~INST_VER~\lib'
installstyle='lib'
installusrbinperl='undef'
+installvendorbin=''
installvendorlib=''
intsize='4'
-known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~'
ksh=''
large=''
ld='link'
man3direxp='~INST_TOP~~INST_VER~\man\man3'
man3ext='3'
medium=''
-mips=''
mips_type=''
mkdir='mkdir'
-mmaptype='void *'
models='none'
modetype='mode_t'
more='more /e'
nm_so_opt=''
nonxs_ext='Errno'
nroff=''
+nvsize='8'
+nvtype='double'
o_nonblock='O_NONBLOCK'
obj_ext='.obj'
old_pthread_create_joinable=''
privlibexp='~INST_TOP~~INST_VER~\lib'
prototype='define'
ptrsize='4'
+quadcase='5'
+quadtype='__int64'
randbits='15'
randfunc='rand'
randseedtype='unsigned'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~'
+sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
+sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~'
sitelib='~INST_TOP~\site~INST_VER~\lib'
sitelibexp='~INST_TOP~\site~INST_VER~\lib'
siteprefix='~INST_TOP~\site~INST_VER~'
tr=''
trnl='\012'
troff=''
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='unsigned __int64'
+u8size='1'
+u8type='unsigned char'
+uidformat='"ld"'
uidsign='-1'
+uidsize='4'
uidtype='uid_t'
uname='uname'
uniq='uniq'
+uquadtype='unsigned __int64'
use64bits='undef'
usedl='define'
uselargefiles='undef'
uselongdouble='undef'
+uselonglong='undef'
usemorebits='undef'
usemultiplicity='undef'
usemymalloc='n'
usevfork='false'
usrinc='/usr/include'
uuname=''
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+uvxformat='"lx"'
+vendorbin=''
+vendorbinexp=''
vendorlib=''
vendorlibexp=''
vendorprefix=''
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='5.00562'
+xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='5.00562'
+PERL_APIVERSION='~PERL_APIVERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
/*
* Package name : perl5
* Source directory :
- * Configuration time: Mon Oct 11 21:25:14 1999
+ * Configuration time: Sun Oct 31 02:10:33 1999
* Configured by : gsar
* Target system :
*/
* This symbol, if defined, indicates that the link routine is
* available to create hard links.
*/
-/*#define HAS_LINK /**/
+#define HAS_LINK /**/
/* HAS_LOCALECONV:
* This symbol, if defined, indicates that the localeconv routine is
*/
#define HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-/*#define HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-/*#define HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define STDCHAR unsigned char /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t.
+ */
+/* Quad_t:
+ * This symbol holds the type used for 64-bit integers.
+ * It can be int, long, long long, int64_t etc...
+ */
+/* QUADCASE:
+ * This symbol, if defined, encodes the type of a quad:
+ * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
+ */
+/* Uquad_t:
+ * This symbol holds the type used for unsigned 64-bit integers.
+ * It can be unsigned int, unsigned long, unsigned long long,
+ * uint64_t etc...
+ */
+/*#define HAS_QUAD /**/
+/*#define Quad_t __int64 /**/
+/*#define Uquad_t unsigned __int64 /**/
+/*#define QUADCASE 5 /**/
+
/* HAS_ACCESSX:
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl\\5.00562\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.00563\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl\\5.00562\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00562")) /**/
+#define PRIVLIB "c:\\perl\\5.00563\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-dependent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl\\site\\5.00562\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.00563\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-independent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl\\site\\5.00562\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00562")) /**/
+#define SITELIB "c:\\perl\\site\\5.00563\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
*/
#define HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-/*#define HAS_MMAP /**/
-#define Mmap_t void * /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#define HAS_SOCKET /**/
/*#define HAS_SOCKETPAIR /**/
/*#define HAS_MSG_CTRUNC /**/
/*#define HAS_MSG_PEEK /**/
/*#define HAS_MSG_PROXY /**/
/*#define HAS_SCM_RIGHTS /**/
-/*#define HAS_SENDMSG /**/
-/*#define HAS_RECVMSG /**/
-/*#define HAS_STRUCT_MSGHDR /**/
-/*#define HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
+#ifndef USE_STAT_BLOCKS
/*#define USE_STAT_BLOCKS /**/
+#endif
/* HAS_STRERROR:
* This symbol, if defined, indicates that the strerror routine is
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/* HAS_STRUCT_IOVEC:
- * This symbol, if defined, indicates that the struct iovec
- * to do scatter writes/gather reads is supported.
- */
/*#define I_SYSUIO /**/
-/*#define HAS_STRUCT_IOVEC /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
*/
/*#define HAS_ENDSPENT /**/
+/* HAS_STRUCT_FS_DATA:
+ * This symbol, if defined, indicates that the struct fs_data
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA /**/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FSEEKO /**/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS /**/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FTELLO /**/
+/* HAS_GETMNT:
+ * This symbol, if defined, indicates that the getmnt routine is
+ * available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT /**/
+
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
- * available to iterate through mounted file systems.
+ * available to iterate through mounted file systems to get their info.
*/
/*#define HAS_GETMNTENT /**/
*/
#define HAS_LDBL_DIG /**/
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-/*#define HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-/*#define HAS_READV /**/
-
/* HAS_SETSPENT:
* This symbol, if defined, indicates that the setspent system call is
* available to initialize the scan of SysV shadow password entries.
*/
/*#define USE_SFIO /**/
-/* HAS_FSTATFS:
- * This symbol, if defined, indicates that the fstatfs routine is
- * available to stat filesystems of file descriptors.
+/* HAS_SQRTL:
+ * This symbol, if defined, indicates that the sqrtl routine is
+ * available to do long double square roots.
*/
-/* HAS_STRUCT_STATFS_FLAGS:
+/*#define HAS_SQRTL /**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* does have the f_flags member containing the mount flags of
- * the filesystem holding the file.
- * This kind of struct statfs is coming from sys/mount.h (BSD),
- * not from sys/statfs.h (SYSV).
+ * the filesystem containing the file.
+ * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not
+ * have statfs() and struct statfs, they have ustat() and getmnt()
+ * with struct ustat and struct fs_data.
*/
-/*#define HAS_FSTATFS /**/
-/*#define HAS_STRUCT_STATFS_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+
+/* HAS_STRUCT_STATFS:
+ * This symbol, if defined, indicates that the struct statfs
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS /**/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
- * available to stat filesystems of file descriptors.
+ * available to stat filesystems by file descriptors.
*/
/*#define HAS_FSTATVFS /**/
*/
#define HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
+/* HAS_USTAT:
+ * This symbol, if defined, indicates that the ustat system call is
+ * available to query file system statistics by dev_t.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_USTAT /**/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
*/
/*#define I_SOCKS /**/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-/*#define I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
/*#define I_SYS_MOUNT /**/
+/* I_SYS_STATFS:
+ * This symbol, if defined, indicates that <sys/statfs.h> exists.
+ */
+/*#define I_SYS_STATFS /**/
+
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
/*#define I_SYS_STATVFS /**/
+/* I_SYS_VFS:
+ * This symbol, if defined, indicates that <sys/vfs.h> exists and
+ * should be included.
+ */
+/*#define I_SYS_VFS /**/
+
+/* I_USTAT:
+ * This symbol, if defined, indicates that <ustat.h> exists and
+ * should be included.
+ */
+/*#define I_USTAT /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
/*#define PERL_PRIfldbl "f" /**/
/*#define PERL_PRIgldbl "g" /**/
-/* PERL_PRId64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit decimal numbers (format 'd') for output.
+/* IVTYPE:
+ * This symbol defines the C type used for Perl's IV.
*/
-/* PERL_PRIu64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit unsigned decimal numbers (format 'u') for output.
+/* UVTYPE:
+ * This symbol defines the C type used for Perl's UV.
*/
-/* PERL_PRIo64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit octal numbers (format 'o') for output.
+/* I8TYPE:
+ * This symbol defines the C type used for Perl's I8.
*/
-/* PERL_PRIx64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit hexadecimal numbers (format 'x') for output.
+/* U8TYPE:
+ * This symbol defines the C type used for Perl's U8.
+ */
+/* I16TYPE:
+ * This symbol defines the C type used for Perl's I16.
+ */
+/* U16TYPE:
+ * This symbol defines the C type used for Perl's U16.
+ */
+/* I32TYPE:
+ * This symbol defines the C type used for Perl's I32.
+ */
+/* U32TYPE:
+ * This symbol defines the C type used for Perl's U32.
+ */
+/* I64TYPE:
+ * This symbol defines the C type used for Perl's I64.
+ */
+/* U64TYPE:
+ * This symbol defines the C type used for Perl's U64.
+ */
+/* NVTYPE:
+ * This symbol defines the C type used for Perl's NV.
+ */
+/* IVSIZE:
+ * This symbol contains the sizeof(IV).
+ */
+/* UVSIZE:
+ * This symbol contains the sizeof(UV).
+ */
+/* I8SIZE:
+ * This symbol contains the sizeof(I8).
+ */
+/* U8SIZE:
+ * This symbol contains the sizeof(U8).
+ */
+/* I16SIZE:
+ * This symbol contains the sizeof(I16).
+ */
+/* U16SIZE:
+ * This symbol contains the sizeof(U16).
+ */
+/* I32SIZE:
+ * This symbol contains the sizeof(I32).
+ */
+/* U32SIZE:
+ * This symbol contains the sizeof(U32).
+ */
+/* I64SIZE:
+ * This symbol contains the sizeof(I64).
+ */
+/* U64SIZE:
+ * This symbol contains the sizeof(U64).
*/
-/*#define PERL_PRId64 "ld" /**/
-/*#define PERL_PRIu64 "lu" /**/
-/*#define PERL_PRIo64 "lo" /**/
-/*#define PERL_PRIx64 "lx" /**/
+/* NVSIZE:
+ * This symbol contains the sizeof(NV).
+ */
+#define IVTYPE long /**/
+#define UVTYPE unsigned long /**/
+#define I8TYPE char /**/
+#define U8TYPE unsigned char /**/
+#define I16TYPE short /**/
+#define U16TYPE unsigned short /**/
+#define I32TYPE long /**/
+#define U32TYPE unsigned long /**/
+#ifdef HAS_QUAD
+#define I64TYPE __int64 /**/
+#define U64TYPE unsigned __int64 /**/
+#endif
+#define NVTYPE double /**/
+#define IVSIZE 4 /**/
+#define UVSIZE 4 /**/
+#define I8SIZE 1 /**/
+#define U8SIZE 1 /**/
+#define I16SIZE 2 /**/
+#define U16SIZE 2 /**/
+#define I32SIZE 4 /**/
+#define U32SIZE 4 /**/
+#ifdef HAS_QUAD
+#define I64SIZE 8 /**/
+#define U64SIZE 8 /**/
+#endif
+#define NVSIZE 8 /**/
+
+/* IVdf:
+ * This symbol defines the format string used for printing a Perl IV
+ * as a signed decimal integer.
+ */
+/* UVuf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned decimal integer.
+ */
+/* UVof:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned octal integer.
+ */
+/* UVxf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned hexadecimal integer.
+ */
+#define IVdf "ld" /**/
+#define UVuf "lu" /**/
+#define UVof "lo" /**/
+#define UVxf "lx" /**/
/* SELECT_MIN_BITS:
* This symbol holds the minimum number of bits operated by select.
* be used when available. If not defined, the native default interfaces
* will be used (be they 32 or 64 bits).
*/
+#ifndef USE_64_BITS
/*#define USE_64_BITS /**/
+#endif
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available. The USE_64_BITS symbol will
* also be turned on if necessary.
*/
+#ifndef USE_LARGE_FILES
/*#define USE_LARGE_FILES /**/
+#endif
/* USE_LONG_DOUBLE:
* This symbol, if defined, indicates that long doubles should
* be used when available.
*/
+#ifndef USE_LONG_DOUBLE
/*#define USE_LONG_DOUBLE /**/
+#endif
+
+/* USE_LONG_LONG:
+ * This symbol, if defined, indicates that long longs should
+ * be used when available.
+ */
+#ifndef USE_LONG_LONG
+/*#define USE_LONG_LONG /**/
+#endif
+
+#ifndef USE_MORE_BITS
+/*#define USE_MORE_BITS /**/
+#endif
/* MULTIPLICITY:
* This symbol, if defined, indicates that Perl should
* be built to use multiplicity.
*/
+#ifndef MULTIPLICTY
/*#define MULTIPLICITY /**/
+#endif
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
* used in a fully backward compatible manner.
*/
+#ifndef USE_PERLIO
/*#define USE_PERLIO /**/
+#endif
/* USE_SOCKS:
* This symbol, if defined, indicates that Perl should
* be built to use socks.
*/
+#ifndef USE_SOCKS
/*#define USE_SOCKS /**/
+#endif
/* PERL_XS_APIVERSION:
* This variable contains the version of the oldest perl binary
* compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00562\\lib\\MSWin32-x86 for older
+ * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
* directories across major versions back to xs_apiversion.
* This is only useful if you have a perl library directory tree
* structured like the default one.
* compatible with the present perl. (That is, pure perl modules
* written for pm_apiversion will still work for the current
* version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00562\\lib for older directories across major versions
+ * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
* back to pm_apiversion. This is only useful if you have a perl
* library directory tree structured like the default one. The
* versioned site_perl library was introduced in 5.005, so that's
* (presumably) be similar.
* See the INSTALL file for how this works.
*/
-#define PERL_XS_APIVERSION 5.00562 /* Change to string for tuples?*/
+#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
+#ifndef USE_TTHREADS
/*#define USE_THREADS /**/
+#endif
/*#define OLD_PTHREADS_API /**/
/* Time_t:
*/
#define Fpos_t fpos_t /* File position type */
+/* Gid_t_f:
+ * This symbol defines the format string used for printing a Gid_t.
+ */
+#define Gid_t_f "d" /**/
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
*/
#define Size_t size_t /* length paramater for string functions */
-/* Uid_t_SIGN:
- * This symbol holds the signedess of a Uid_t.
- * 1 for unsigned, -1 for signed.
+/* Uid_t_f:
+ * This symbol defines the format string used for printing a Uid_t.
*/
-#define Uid_t_SIGN -1 /* UID sign */
+#define Uid_t_f "d" /**/
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
/*
* Package name : perl5
* Source directory :
- * Configuration time: Mon Oct 11 21:25:05 1999
+ * Configuration time: Sun Oct 31 02:10:12 1999
* Configured by : gsar
* Target system :
*/
* This symbol, if defined, indicates that the link routine is
* available to create hard links.
*/
-/*#define HAS_LINK /**/
+#define HAS_LINK /**/
/* HAS_LOCALECONV:
* This symbol, if defined, indicates that the localeconv routine is
*/
#define HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-/*#define HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-/*#define HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define STDCHAR char /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t.
+ */
+/* Quad_t:
+ * This symbol holds the type used for 64-bit integers.
+ * It can be int, long, long long, int64_t etc...
+ */
+/* QUADCASE:
+ * This symbol, if defined, encodes the type of a quad:
+ * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
+ */
+/* Uquad_t:
+ * This symbol holds the type used for unsigned 64-bit integers.
+ * It can be unsigned int, unsigned long, unsigned long long,
+ * uint64_t etc...
+ */
+/*#define HAS_QUAD /**/
+/*#define Quad_t long long /**/
+/*#define Uquad_t unsigned long long /**/
+/*#define QUADCASE 5 /**/
+
/* HAS_ACCESSX:
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl\\5.00562\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.00563\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl\\5.00562\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00562")) /**/
+#define PRIVLIB "c:\\perl\\5.00563\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-dependent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl\\site\\5.00562\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.00563\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-independent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl\\site\\5.00562\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00562")) /**/
+#define SITELIB "c:\\perl\\site\\5.00563\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
*/
#define HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-/*#define HAS_MMAP /**/
-#define Mmap_t void * /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#define HAS_SOCKET /**/
/*#define HAS_SOCKETPAIR /**/
/*#define HAS_MSG_CTRUNC /**/
/*#define HAS_MSG_PEEK /**/
/*#define HAS_MSG_PROXY /**/
/*#define HAS_SCM_RIGHTS /**/
-/*#define HAS_SENDMSG /**/
-/*#define HAS_RECVMSG /**/
-/*#define HAS_STRUCT_MSGHDR /**/
-/*#define HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
+#ifndef USE_STAT_BLOCKS
/*#define USE_STAT_BLOCKS /**/
+#endif
/* HAS_STRERROR:
* This symbol, if defined, indicates that the strerror routine is
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/* HAS_STRUCT_IOVEC:
- * This symbol, if defined, indicates that the struct iovec
- * to do scatter writes/gather reads is supported.
- */
/*#define I_SYSUIO /**/
-/*#define HAS_STRUCT_IOVEC /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
*/
/*#define HAS_ENDSPENT /**/
+/* HAS_STRUCT_FS_DATA:
+ * This symbol, if defined, indicates that the struct fs_data
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA /**/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FSEEKO /**/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS /**/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FTELLO /**/
+/* HAS_GETMNT:
+ * This symbol, if defined, indicates that the getmnt routine is
+ * available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT /**/
+
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
- * available to iterate through mounted file systems.
+ * available to iterate through mounted file systems to get their info.
*/
/*#define HAS_GETMNTENT /**/
*/
#define HAS_LDBL_DIG /**/
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-/*#define HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-/*#define HAS_READV /**/
-
/* HAS_SETSPENT:
* This symbol, if defined, indicates that the setspent system call is
* available to initialize the scan of SysV shadow password entries.
*/
/*#define USE_SFIO /**/
-/* HAS_FSTATFS:
- * This symbol, if defined, indicates that the fstatfs routine is
- * available to stat filesystems of file descriptors.
+/* HAS_SQRTL:
+ * This symbol, if defined, indicates that the sqrtl routine is
+ * available to do long double square roots.
*/
-/* HAS_STRUCT_STATFS_FLAGS:
+/*#define HAS_SQRTL /**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* does have the f_flags member containing the mount flags of
- * the filesystem holding the file.
- * This kind of struct statfs is coming from sys/mount.h (BSD),
- * not from sys/statfs.h (SYSV).
+ * the filesystem containing the file.
+ * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not
+ * have statfs() and struct statfs, they have ustat() and getmnt()
+ * with struct ustat and struct fs_data.
*/
-/*#define HAS_FSTATFS /**/
-/*#define HAS_STRUCT_STATFS_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+
+/* HAS_STRUCT_STATFS:
+ * This symbol, if defined, indicates that the struct statfs
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS /**/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
- * available to stat filesystems of file descriptors.
+ * available to stat filesystems by file descriptors.
*/
/*#define HAS_FSTATVFS /**/
*/
#define HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
+/* HAS_USTAT:
+ * This symbol, if defined, indicates that the ustat system call is
+ * available to query file system statistics by dev_t.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_USTAT /**/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
*/
/*#define I_SOCKS /**/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-/*#define I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
/*#define I_SYS_MOUNT /**/
+/* I_SYS_STATFS:
+ * This symbol, if defined, indicates that <sys/statfs.h> exists.
+ */
+/*#define I_SYS_STATFS /**/
+
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
/*#define I_SYS_STATVFS /**/
+/* I_SYS_VFS:
+ * This symbol, if defined, indicates that <sys/vfs.h> exists and
+ * should be included.
+ */
+/*#define I_SYS_VFS /**/
+
+/* I_USTAT:
+ * This symbol, if defined, indicates that <ustat.h> exists and
+ * should be included.
+ */
+/*#define I_USTAT /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
/*#define PERL_PRIfldbl "f" /**/
/*#define PERL_PRIgldbl "g" /**/
-/* PERL_PRId64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit decimal numbers (format 'd') for output.
+/* IVTYPE:
+ * This symbol defines the C type used for Perl's IV.
*/
-/* PERL_PRIu64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit unsigned decimal numbers (format 'u') for output.
+/* UVTYPE:
+ * This symbol defines the C type used for Perl's UV.
*/
-/* PERL_PRIo64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit octal numbers (format 'o') for output.
+/* I8TYPE:
+ * This symbol defines the C type used for Perl's I8.
*/
-/* PERL_PRIx64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit hexadecimal numbers (format 'x') for output.
+/* U8TYPE:
+ * This symbol defines the C type used for Perl's U8.
+ */
+/* I16TYPE:
+ * This symbol defines the C type used for Perl's I16.
+ */
+/* U16TYPE:
+ * This symbol defines the C type used for Perl's U16.
+ */
+/* I32TYPE:
+ * This symbol defines the C type used for Perl's I32.
+ */
+/* U32TYPE:
+ * This symbol defines the C type used for Perl's U32.
+ */
+/* I64TYPE:
+ * This symbol defines the C type used for Perl's I64.
+ */
+/* U64TYPE:
+ * This symbol defines the C type used for Perl's U64.
+ */
+/* NVTYPE:
+ * This symbol defines the C type used for Perl's NV.
+ */
+/* IVSIZE:
+ * This symbol contains the sizeof(IV).
+ */
+/* UVSIZE:
+ * This symbol contains the sizeof(UV).
+ */
+/* I8SIZE:
+ * This symbol contains the sizeof(I8).
+ */
+/* U8SIZE:
+ * This symbol contains the sizeof(U8).
+ */
+/* I16SIZE:
+ * This symbol contains the sizeof(I16).
+ */
+/* U16SIZE:
+ * This symbol contains the sizeof(U16).
+ */
+/* I32SIZE:
+ * This symbol contains the sizeof(I32).
+ */
+/* U32SIZE:
+ * This symbol contains the sizeof(U32).
+ */
+/* I64SIZE:
+ * This symbol contains the sizeof(I64).
+ */
+/* U64SIZE:
+ * This symbol contains the sizeof(U64).
*/
-/*#define PERL_PRId64 "ld" /**/
-/*#define PERL_PRIu64 "lu" /**/
-/*#define PERL_PRIo64 "lo" /**/
-/*#define PERL_PRIx64 "lx" /**/
+/* NVSIZE:
+ * This symbol contains the sizeof(NV).
+ */
+#define IVTYPE long /**/
+#define UVTYPE unsigned long /**/
+#define I8TYPE char /**/
+#define U8TYPE unsigned char /**/
+#define I16TYPE short /**/
+#define U16TYPE unsigned short /**/
+#define I32TYPE long /**/
+#define U32TYPE unsigned long /**/
+#ifdef HAS_QUAD
+#define I64TYPE long long /**/
+#define U64TYPE unsigned long long /**/
+#endif
+#define NVTYPE double /**/
+#define IVSIZE 4 /**/
+#define UVSIZE 4 /**/
+#define I8SIZE 1 /**/
+#define U8SIZE 1 /**/
+#define I16SIZE 2 /**/
+#define U16SIZE 2 /**/
+#define I32SIZE 4 /**/
+#define U32SIZE 4 /**/
+#ifdef HAS_QUAD
+#define I64SIZE 8 /**/
+#define U64SIZE 8 /**/
+#endif
+#define NVSIZE 8 /**/
+
+/* IVdf:
+ * This symbol defines the format string used for printing a Perl IV
+ * as a signed decimal integer.
+ */
+/* UVuf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned decimal integer.
+ */
+/* UVof:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned octal integer.
+ */
+/* UVxf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned hexadecimal integer.
+ */
+#define IVdf "ld" /**/
+#define UVuf "lu" /**/
+#define UVof "lo" /**/
+#define UVxf "lx" /**/
/* SELECT_MIN_BITS:
* This symbol holds the minimum number of bits operated by select.
* be used when available. If not defined, the native default interfaces
* will be used (be they 32 or 64 bits).
*/
+#ifndef USE_64_BITS
/*#define USE_64_BITS /**/
+#endif
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available. The USE_64_BITS symbol will
* also be turned on if necessary.
*/
+#ifndef USE_LARGE_FILES
/*#define USE_LARGE_FILES /**/
+#endif
/* USE_LONG_DOUBLE:
* This symbol, if defined, indicates that long doubles should
* be used when available.
*/
+#ifndef USE_LONG_DOUBLE
/*#define USE_LONG_DOUBLE /**/
+#endif
+
+/* USE_LONG_LONG:
+ * This symbol, if defined, indicates that long longs should
+ * be used when available.
+ */
+#ifndef USE_LONG_LONG
+/*#define USE_LONG_LONG /**/
+#endif
+
+#ifndef USE_MORE_BITS
+/*#define USE_MORE_BITS /**/
+#endif
/* MULTIPLICITY:
* This symbol, if defined, indicates that Perl should
* be built to use multiplicity.
*/
+#ifndef MULTIPLICTY
/*#define MULTIPLICITY /**/
+#endif
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
* used in a fully backward compatible manner.
*/
+#ifndef USE_PERLIO
/*#define USE_PERLIO /**/
+#endif
/* USE_SOCKS:
* This symbol, if defined, indicates that Perl should
* be built to use socks.
*/
+#ifndef USE_SOCKS
/*#define USE_SOCKS /**/
+#endif
/* PERL_XS_APIVERSION:
* This variable contains the version of the oldest perl binary
* compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00562\\lib\\MSWin32-x86 for older
+ * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
* directories across major versions back to xs_apiversion.
* This is only useful if you have a perl library directory tree
* structured like the default one.
* compatible with the present perl. (That is, pure perl modules
* written for pm_apiversion will still work for the current
* version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00562\\lib for older directories across major versions
+ * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
* back to pm_apiversion. This is only useful if you have a perl
* library directory tree structured like the default one. The
* versioned site_perl library was introduced in 5.005, so that's
* (presumably) be similar.
* See the INSTALL file for how this works.
*/
-#define PERL_XS_APIVERSION 5.00562 /* Change to string for tuples?*/
+#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
+#ifndef USE_TTHREADS
/*#define USE_THREADS /**/
+#endif
/*#define OLD_PTHREADS_API /**/
/* Time_t:
*/
#define Fpos_t fpos_t /* File position type */
+/* Gid_t_f:
+ * This symbol defines the format string used for printing a Gid_t.
+ */
+#define Gid_t_f "ld" /**/
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
*/
#define Size_t size_t /* length paramater for string functions */
-/* Uid_t_SIGN:
- * This symbol holds the signedess of a Uid_t.
- * 1 for unsigned, -1 for signed.
+/* Uid_t_f:
+ * This symbol defines the format string used for printing a Uid_t.
*/
-#define Uid_t_SIGN -1 /* UID sign */
+#define Uid_t_f "ld" /**/
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
/*
* Package name : perl5
* Source directory :
- * Configuration time: Mon Oct 11 21:24:59 1999
+ * Configuration time: Sun Oct 31 02:10:23 1999
* Configured by : gsar
* Target system :
*/
* This symbol, if defined, indicates that the link routine is
* available to create hard links.
*/
-/*#define HAS_LINK /**/
+#define HAS_LINK /**/
/* HAS_LOCALECONV:
* This symbol, if defined, indicates that the localeconv routine is
*/
#define HAS_MKTIME /**/
-/* HAS_MSYNC:
- * This symbol, if defined, indicates that the msync system call is
- * available to synchronize a mapped file.
- */
-/*#define HAS_MSYNC /**/
-
-/* HAS_MUNMAP:
- * This symbol, if defined, indicates that the munmap system call is
- * available to unmap a region, usually mapped by mmap().
- */
-/*#define HAS_MUNMAP /**/
-
/* HAS_NICE:
* This symbol, if defined, indicates that the nice routine is
* available.
*/
#define STDCHAR char /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t.
+ */
+/* Quad_t:
+ * This symbol holds the type used for 64-bit integers.
+ * It can be int, long, long long, int64_t etc...
+ */
+/* QUADCASE:
+ * This symbol, if defined, encodes the type of a quad:
+ * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
+ */
+/* Uquad_t:
+ * This symbol holds the type used for unsigned 64-bit integers.
+ * It can be unsigned int, unsigned long, unsigned long long,
+ * uint64_t etc...
+ */
+/*#define HAS_QUAD /**/
+/*#define Quad_t __int64 /**/
+/*#define Uquad_t unsigned __int64 /**/
+/*#define QUADCASE 5 /**/
+
/* HAS_ACCESSX:
* This symbol, if defined, indicates that the accessx routine is
* available to do extended access checks.
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl\\5.00562\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.00563\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00562\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl\\5.00562\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00562")) /**/
+#define PRIVLIB "c:\\perl\\5.00563\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-dependent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl\\site\\5.00562\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.00563\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
* The standard distribution will put nothing in this directory.
- * Individual sites may place their own extensions and modules in
- * this directory.
+ * After perl has been installed, users may install their own local
+ * architecture-independent modules in this directory with
+ * MakeMaker Makefile.PL
+ * or equivalent. See INSTALL for details.
*/
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl\\site\\5.00562\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00562")) /**/
+#define SITELIB "c:\\perl\\site\\5.00563\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
*/
#define HAS_MEMCHR /**/
-/* HAS_MMAP:
- * This symbol, if defined, indicates that the mmap system call is
- * available to map a file into memory.
- */
-/* Mmap_t:
- * This symbol holds the return type of the mmap() system call
- * (and simultaneously the type of the first argument).
- * Usually set to 'void *' or 'cadd_t'.
- */
-/*#define HAS_MMAP /**/
-#define Mmap_t void * /**/
-
/* HAS_MSG:
* This symbol, if defined, indicates that the entire msg*(2) library is
* supported (IPC mechanism based on message queues).
* Checking just with #ifdef might not be enough because this symbol
* has been known to be an enum.
*/
-/* HAS_SENDMSG:
- * This symbol, if defined, indicates that the sendmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_RECVMSG:
- * This symbol, if defined, indicates that the recvmsg is supported
- * to send messages between sockets. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_MSGHDR:
- * This symbol, if defined, indicates that the struct msghdr
- * (BSD 4.3 or 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
-/* HAS_STRUCT_CMSGHDR:
- * This symbol, if defined, indicates that the struct cmsghdr
- * (BSD 4.4) is supported. You will also need struct
- * iovec from <sys/uio.h>, HAS_STRUCT_IOVEC and I_SYSUIO.
- */
#define HAS_SOCKET /**/
/*#define HAS_SOCKETPAIR /**/
/*#define HAS_MSG_CTRUNC /**/
/*#define HAS_MSG_PEEK /**/
/*#define HAS_MSG_PROXY /**/
/*#define HAS_SCM_RIGHTS /**/
-/*#define HAS_SENDMSG /**/
-/*#define HAS_RECVMSG /**/
-/*#define HAS_STRUCT_MSGHDR /**/
-/*#define HAS_STRUCT_CMSGHDR /**/
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
+#ifndef USE_STAT_BLOCKS
/*#define USE_STAT_BLOCKS /**/
+#endif
/* HAS_STRERROR:
* This symbol, if defined, indicates that the strerror routine is
* This symbol, if defined, indicates that <sys/uio.h> exists and
* should be included.
*/
-/* HAS_STRUCT_IOVEC:
- * This symbol, if defined, indicates that the struct iovec
- * to do scatter writes/gather reads is supported.
- */
/*#define I_SYSUIO /**/
-/*#define HAS_STRUCT_IOVEC /**/
/* Free_t:
* This variable contains the return type of free(). It is usually
*/
/*#define HAS_ENDSPENT /**/
+/* HAS_STRUCT_FS_DATA:
+ * This symbol, if defined, indicates that the struct fs_data
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_FS_DATA /**/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FSEEKO /**/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat filesystems by file descriptors.
+ */
+/*#define HAS_FSTATFS /**/
/* HAS_FTELLO:
* This symbol, if defined, indicates that the ftello routine is
* available to ftell beyond 32 bits (useful for ILP32 hosts).
*/
/*#define HAS_FTELLO /**/
+/* HAS_GETMNT:
+ * This symbol, if defined, indicates that the getmnt routine is
+ * available to get filesystem mount info by filename.
+ */
+/*#define HAS_GETMNT /**/
+
/* HAS_GETMNTENT:
* This symbol, if defined, indicates that the getmntent routine is
- * available to iterate through mounted file systems.
+ * available to iterate through mounted file systems to get their info.
*/
/*#define HAS_GETMNTENT /**/
*/
#define HAS_LDBL_DIG /**/
-/* HAS_MADVISE:
- * This symbol, if defined, indicates that the madvise system call is
- * available to map a file into memory.
- */
-/*#define HAS_MADVISE /**/
-
-/* HAS_MPROTECT:
- * This symbol, if defined, indicates that the mprotect system call is
- * available to modify the access protection of a memory mapped file.
- */
-/*#define HAS_MPROTECT /**/
-
-/* HAS_READV:
- * This symbol, if defined, indicates that the readv routine is
- * available to do gather reads. You will also need <sys/uio.h>
- * and there I_SYSUIO.
- */
-/*#define HAS_READV /**/
-
/* HAS_SETSPENT:
* This symbol, if defined, indicates that the setspent system call is
* available to initialize the scan of SysV shadow password entries.
*/
/*#define USE_SFIO /**/
-/* HAS_FSTATFS:
- * This symbol, if defined, indicates that the fstatfs routine is
- * available to stat filesystems of file descriptors.
+/* HAS_SQRTL:
+ * This symbol, if defined, indicates that the sqrtl routine is
+ * available to do long double square roots.
*/
-/* HAS_STRUCT_STATFS_FLAGS:
+/*#define HAS_SQRTL /**/
+
+/* HAS_STRUCT_STATFS_F_FLAGS:
* This symbol, if defined, indicates that the struct statfs
* does have the f_flags member containing the mount flags of
- * the filesystem holding the file.
- * This kind of struct statfs is coming from sys/mount.h (BSD),
- * not from sys/statfs.h (SYSV).
+ * the filesystem containing the file.
+ * This kind of struct statfs is coming from <sys/mount.h> (BSD 4.3),
+ * not from <sys/statfs.h> (SYSV). Older BSDs (like Ultrix) do not
+ * have statfs() and struct statfs, they have ustat() and getmnt()
+ * with struct ustat and struct fs_data.
*/
-/*#define HAS_FSTATFS /**/
-/*#define HAS_STRUCT_STATFS_FLAGS /**/
+/*#define HAS_STRUCT_STATFS_F_FLAGS /**/
+
+/* HAS_STRUCT_STATFS:
+ * This symbol, if defined, indicates that the struct statfs
+ * to do statfs() is supported.
+ */
+/*#define HAS_STRUCT_STATFS /**/
/* HAS_FSTATVFS:
* This symbol, if defined, indicates that the fstatvfs routine is
- * available to stat filesystems of file descriptors.
+ * available to stat filesystems by file descriptors.
*/
/*#define HAS_FSTATVFS /**/
*/
#define HAS_TELLDIR_PROTO /**/
-/* HAS_WRITEV:
- * This symbol, if defined, indicates that the writev routine is
- * available to do scatter writes.
+/* HAS_USTAT:
+ * This symbol, if defined, indicates that the ustat system call is
+ * available to query file system statistics by dev_t.
*/
-/*#define HAS_WRITEV /**/
+/*#define HAS_USTAT /**/
/* USE_DYNAMIC_LOADING:
* This symbol, if defined, indicates that dynamic loading of
*/
/*#define I_SOCKS /**/
-/* I_SYS_MMAN:
- * This symbol, if defined, indicates that <sys/mman.h> exists and
- * should be included.
- */
-/*#define I_SYS_MMAN /**/
-
/* I_SYS_MOUNT:
* This symbol, if defined, indicates that <sys/mount.h> exists and
* should be included.
*/
/*#define I_SYS_MOUNT /**/
+/* I_SYS_STATFS:
+ * This symbol, if defined, indicates that <sys/statfs.h> exists.
+ */
+/*#define I_SYS_STATFS /**/
+
/* I_SYS_STATVFS:
* This symbol, if defined, indicates that <sys/statvfs.h> exists and
* should be included.
*/
/*#define I_SYS_STATVFS /**/
+/* I_SYS_VFS:
+ * This symbol, if defined, indicates that <sys/vfs.h> exists and
+ * should be included.
+ */
+/*#define I_SYS_VFS /**/
+
+/* I_USTAT:
+ * This symbol, if defined, indicates that <ustat.h> exists and
+ * should be included.
+ */
+/*#define I_USTAT /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
/*#define PERL_PRIfldbl "f" /**/
/*#define PERL_PRIgldbl "g" /**/
-/* PERL_PRId64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit decimal numbers (format 'd') for output.
+/* IVTYPE:
+ * This symbol defines the C type used for Perl's IV.
*/
-/* PERL_PRIu64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit unsigned decimal numbers (format 'u') for output.
+/* UVTYPE:
+ * This symbol defines the C type used for Perl's UV.
*/
-/* PERL_PRIo64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit octal numbers (format 'o') for output.
+/* I8TYPE:
+ * This symbol defines the C type used for Perl's I8.
*/
-/* PERL_PRIx64:
- * This symbol, if defined, contains the string used by stdio to
- * format 64-bit hexadecimal numbers (format 'x') for output.
+/* U8TYPE:
+ * This symbol defines the C type used for Perl's U8.
+ */
+/* I16TYPE:
+ * This symbol defines the C type used for Perl's I16.
+ */
+/* U16TYPE:
+ * This symbol defines the C type used for Perl's U16.
+ */
+/* I32TYPE:
+ * This symbol defines the C type used for Perl's I32.
+ */
+/* U32TYPE:
+ * This symbol defines the C type used for Perl's U32.
+ */
+/* I64TYPE:
+ * This symbol defines the C type used for Perl's I64.
+ */
+/* U64TYPE:
+ * This symbol defines the C type used for Perl's U64.
+ */
+/* NVTYPE:
+ * This symbol defines the C type used for Perl's NV.
+ */
+/* IVSIZE:
+ * This symbol contains the sizeof(IV).
+ */
+/* UVSIZE:
+ * This symbol contains the sizeof(UV).
+ */
+/* I8SIZE:
+ * This symbol contains the sizeof(I8).
+ */
+/* U8SIZE:
+ * This symbol contains the sizeof(U8).
+ */
+/* I16SIZE:
+ * This symbol contains the sizeof(I16).
+ */
+/* U16SIZE:
+ * This symbol contains the sizeof(U16).
+ */
+/* I32SIZE:
+ * This symbol contains the sizeof(I32).
+ */
+/* U32SIZE:
+ * This symbol contains the sizeof(U32).
+ */
+/* I64SIZE:
+ * This symbol contains the sizeof(I64).
+ */
+/* U64SIZE:
+ * This symbol contains the sizeof(U64).
*/
-/*#define PERL_PRId64 "ld" /**/
-/*#define PERL_PRIu64 "lu" /**/
-/*#define PERL_PRIo64 "lo" /**/
-/*#define PERL_PRIx64 "lx" /**/
+/* NVSIZE:
+ * This symbol contains the sizeof(NV).
+ */
+#define IVTYPE long /**/
+#define UVTYPE unsigned long /**/
+#define I8TYPE char /**/
+#define U8TYPE unsigned char /**/
+#define I16TYPE short /**/
+#define U16TYPE unsigned short /**/
+#define I32TYPE long /**/
+#define U32TYPE unsigned long /**/
+#ifdef HAS_QUAD
+#define I64TYPE __int64 /**/
+#define U64TYPE unsigned __int64 /**/
+#endif
+#define NVTYPE double /**/
+#define IVSIZE 4 /**/
+#define UVSIZE 4 /**/
+#define I8SIZE 1 /**/
+#define U8SIZE 1 /**/
+#define I16SIZE 2 /**/
+#define U16SIZE 2 /**/
+#define I32SIZE 4 /**/
+#define U32SIZE 4 /**/
+#ifdef HAS_QUAD
+#define I64SIZE 8 /**/
+#define U64SIZE 8 /**/
+#endif
+#define NVSIZE 8 /**/
+
+/* IVdf:
+ * This symbol defines the format string used for printing a Perl IV
+ * as a signed decimal integer.
+ */
+/* UVuf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned decimal integer.
+ */
+/* UVof:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned octal integer.
+ */
+/* UVxf:
+ * This symbol defines the format string used for printing a Perl UV
+ * as an unsigned hexadecimal integer.
+ */
+#define IVdf "ld" /**/
+#define UVuf "lu" /**/
+#define UVof "lo" /**/
+#define UVxf "lx" /**/
/* SELECT_MIN_BITS:
* This symbol holds the minimum number of bits operated by select.
* be used when available. If not defined, the native default interfaces
* will be used (be they 32 or 64 bits).
*/
+#ifndef USE_64_BITS
/*#define USE_64_BITS /**/
+#endif
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available. The USE_64_BITS symbol will
* also be turned on if necessary.
*/
+#ifndef USE_LARGE_FILES
/*#define USE_LARGE_FILES /**/
+#endif
/* USE_LONG_DOUBLE:
* This symbol, if defined, indicates that long doubles should
* be used when available.
*/
+#ifndef USE_LONG_DOUBLE
/*#define USE_LONG_DOUBLE /**/
+#endif
+
+/* USE_LONG_LONG:
+ * This symbol, if defined, indicates that long longs should
+ * be used when available.
+ */
+#ifndef USE_LONG_LONG
+/*#define USE_LONG_LONG /**/
+#endif
+
+#ifndef USE_MORE_BITS
+/*#define USE_MORE_BITS /**/
+#endif
/* MULTIPLICITY:
* This symbol, if defined, indicates that Perl should
* be built to use multiplicity.
*/
+#ifndef MULTIPLICTY
/*#define MULTIPLICITY /**/
+#endif
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
* used in a fully backward compatible manner.
*/
+#ifndef USE_PERLIO
/*#define USE_PERLIO /**/
+#endif
/* USE_SOCKS:
* This symbol, if defined, indicates that Perl should
* be built to use socks.
*/
+#ifndef USE_SOCKS
/*#define USE_SOCKS /**/
+#endif
/* PERL_XS_APIVERSION:
* This variable contains the version of the oldest perl binary
* compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00562\\lib\\MSWin32-x86 for older
+ * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
* directories across major versions back to xs_apiversion.
* This is only useful if you have a perl library directory tree
* structured like the default one.
* compatible with the present perl. (That is, pure perl modules
* written for pm_apiversion will still work for the current
* version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00562\\lib for older directories across major versions
+ * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
* back to pm_apiversion. This is only useful if you have a perl
* library directory tree structured like the default one. The
* versioned site_perl library was introduced in 5.005, so that's
* (presumably) be similar.
* See the INSTALL file for how this works.
*/
-#define PERL_XS_APIVERSION 5.00562 /* Change to string for tuples?*/
+#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
+#ifndef USE_TTHREADS
/*#define USE_THREADS /**/
+#endif
/*#define OLD_PTHREADS_API /**/
/* Time_t:
*/
#define Fpos_t fpos_t /* File position type */
+/* Gid_t_f:
+ * This symbol defines the format string used for printing a Gid_t.
+ */
+#define Gid_t_f "ld" /**/
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
*/
#define Size_t size_t /* length paramater for string functions */
-/* Uid_t_SIGN:
- * This symbol holds the signedess of a Uid_t.
- * 1 for unsigned, -1 for signed.
+/* Uid_t_f:
+ * This symbol defines the format string used for printing a Uid_t.
*/
-#define Uid_t_SIGN -1 /* UID sign */
+#define Uid_t_f "ld" /**/
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
return join(' ', @p);
}
+# generate an array of option strings from command-line args
+# or an option file
+# -- added by BKS, 10-17-1999 to fix command-line overflow problems
+sub loadopts {
+ if ($ARGV[0] =~ /--cfgsh-option-file/) {
+ shift @ARGV;
+ my $optfile = shift @ARGV;
+ local (*F);
+ open OPTF, $optfile or die "Can't open $optfile: $!\n";
+ my @opts;
+ chomp(my $line = <OPTF>);
+ my @vars = split(/\t+~\t+/, $line);
+ for (@vars) {
+ push(@opts, $_) unless (/^\s*$/);
+ }
+ close OPTF;
+ return \@opts;
+ }
+ else {
+ return \@ARGV;
+ }
+}
+
my %opt;
-while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
- {
- $opt{$1}=$2;
- shift(@ARGV);
- }
+my $optref = loadopts();
+while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
+ $opt{$1}=$2;
+ shift(@{$optref});
+}
+
+my $pl_h = '../patchlevel.h';
$opt{VERSION} = $];
$opt{INST_VER} =~ s|~VERSION~|$]|g;
-if ($] =~ /^(\d+)\.(\d\d\d)?(\d\d)?$/) { # should always be true
- $opt{PERL_REVISION} = $1;
- $opt{PERL_VERSION} = int($2 || 0);
- $opt{PERL_SUBVERSION} = $3 || '00';
+if (-e $pl_h) {
+ open PL, "<$pl_h" or die "Can't open $pl_h: $!";
+ while (<PL>) {
+ if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) {
+ $opt{$1} = $2;
+ }
+ }
+ close PL;
+}
+elsif ($] =~ /^(\d+)\.(\d\d\d)?(\d\d)?$/) { # should always be true
+ $opt{PERL_REVISION} = $1;
+ $opt{PERL_VERSION} = int($2 || 0);
+ $opt{PERL_SUBVERSION} = $3;
+ $opt{PERL_APIVERSION} = $];
}
else {
- die "Can't parse perl version ($])";
+ die "Can't parse perl version ($])";
}
+$opt{PERL_SUBVERSION} ||= '00';
+
$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
unless $opt{'cf_email'};
$opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth};
$opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath};
-while (<>)
- {
- s/~([\w_]+)~/$opt{$1}/g;
- if (/^([\w_]+)=(.*)$/) {
- my($k,$v) = ($1,$2);
- # this depends on cf_time being empty in the template (or we'll get a loop)
- if ($k eq 'cf_time') {
- $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/;
+while (<>) {
+ s/~([\w_]+)~/$opt{$1}/g;
+ if (/^([\w_]+)=(.*)$/) {
+ my($k,$v) = ($1,$2);
+ # this depends on cf_time being empty in the template (or we'll
+ # get a loop)
+ if ($k eq 'cf_time') {
+ $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/;
+ }
+ elsif (exists $opt{$k}) {
+ $_ = "$k='$opt{$k}'\n";
+ }
}
- elsif (exists $opt{$k}) {
- $_ = "$k='$opt{$k}'\n";
- }
- }
- print;
- }
+ print;
+}
-# genmk95.pl - uses miniperl to generate a makefile that command.com
-# (and dmake) will understand given one that cmd.exe will understand
+# genmk95.pl - uses miniperl to generate a makefile that command.com will
+# understand given one that cmd.exe will understand
# Author: Benjamin K. Stuhl
-# Date: 8-18-1999
+# Date: 10-16-1999
# how it works:
# dmake supports an alternative form for its recipes, called "group
-# recipes", in which all elements of a recipe are run with only one
-# shell. This program converts the standard dmake makefile.mk to
-# one using group recipes. This is done so that lines using && or
-# || (which command.com doesn't understand) may be split into two
-# lines.
+# recipes", in which all elements of a recipe are run with only one shell.
+# This program converts the standard dmake makefile.mk to one using group
+# recipes. This is done so that lines using && or || (which command.com
+# doesn't understand) may be split into two lines that will still be run
+# with one shell.
my ($filein, $fileout) = @ARGV;
-chomp (my $loc = `cd`);
-
-open my $in, $filein or die "Error opening input file: $!";
-open my $out, "> $fileout" or die "Error opening output file: $!";
+open my $in, $filein or die "Error opening input file: $!\n";
+open my $out, "> $fileout" or die "Error opening output file: $!\n";
print $out <<_EOH_;
# *** Warning: this file is autogenerated from $filein by $0 ***
# *** Do not edit this file - edit $filein instead ***
+_HOME_DIR := \$(PWD)
+
_EOH_
my $inrec = 0;
while (<$in>)
{
chomp;
- if (/^[^#.\t][^#=]*?:/)
+ if (/^[^#.\t][^#=]*?:(?:[^=]|$)/)
{
if (! $inrec)
{
print $out "$_\n";
- while (/\\$/)
+ while (/\\\s*$/)
{
chomp($_ = <$in>);
print $out "$_\n";
s/^\s*// for ($one, $two);
print $out "\t$one\n\t$two\n" if ($sep eq "&&");
print $out "\t$one\n\tif errorlevel 1 $two\n" if ($sep eq "||");
- print $out "\tcd $loc\n";
+ print $out "\tcd \$(_HOME_DIR)\n";
next;
}
# fall through - no need for special handling
}
print $out "]\n" if ($inrec);
-close $in; close $out;
+close $in or warn "Error closing \$in: $!\n";
+close $out or warn "Error closing \$out: $!\n";
--- /dev/null
+/*
+ * gstartup.c
+ *
+ * Startup file for GCC/Mingw32 builds
+ * (replaces gcc's default c:\egcs\...\{crt1.o,dllcrt1.o})
+ *
+ * This file is taken from the Mingw32 package.
+ * Created by Colin Peters for Mingw32
+ * Modified by Mumit Khan
+ *
+ * History with Perl:
+ * Added (in modified form) to Perl standard distribution to fix
+ * problems linking against PerlCRT or MSVCRT
+ * -- Benjamin Stuhl <sho_pi@hotmail.com> 10-17-1999
+*/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <io.h>
+#include <fcntl.h>
+#include <process.h>
+#include <float.h>
+#include <windows.h>
+#include <signal.h>
+
+/*
+ * Access to a standard 'main'-like argument count and list. Also included
+ * is a table of environment variables.
+ */
+int _argc;
+char **_argv;
+
+extern int _CRT_glob;
+
+#ifdef __MSVCRT__
+typedef struct {
+ int newmode;
+} _startupinfo;
+extern void __getmainargs (int *, char ***, char ***, int, _startupinfo *);
+#else
+extern void __GetMainArgs (int *, char ***, char ***, int);
+#endif
+
+/*
+ * Initialize the _argc, _argv and environ variables.
+ */
+static void
+_mingw32_init_mainargs ()
+{
+ /* The environ variable is provided directly in stdlib.h through
+ * a dll function call. */
+ char **dummy_environ;
+#ifdef __MSVCRT__
+ _startupinfo start_info;
+ start_info.newmode = 0;
+#endif
+
+ /*
+ * Microsoft's runtime provides a function for doing just that.
+ */
+#ifdef __MSVCRT__
+ (void) __getmainargs (&_argc, &_argv, &dummy_environ, _CRT_glob,
+ &start_info);
+#else
+ /* CRTDLL version */
+ (void) __GetMainArgs (&_argc, &_argv, &dummy_environ, _CRT_glob);
+#endif
+}
+
+#if defined(EXESTARTUP) /* gcrt0.o - startup for an executable */
+
+extern int main (int, char **, char **);
+
+/*
+ * Must have the correct app type for MSVCRT.
+ */
+
+#ifdef __MSVCRT__
+#define __UNKNOWN_APP 0
+#define __CONSOLE_APP 1
+#define __GUI_APP 2
+__MINGW_IMPORT void __set_app_type(int);
+#endif /* __MSVCRT__ */
+
+/*
+ * Setup the default file handles to have the _CRT_fmode mode, as well as
+ * any new files created by the user.
+ */
+extern unsigned int _CRT_fmode;
+
+static void
+_mingw32_init_fmode ()
+{
+ /* Don't set the file mode if the user hasn't set any value for it. */
+ if (_CRT_fmode)
+ {
+ _fmode = _CRT_fmode;
+
+ /*
+ * This overrides the default file mode settings for stdin,
+ * stdout and stderr. At first I thought you would have to
+ * test with isatty, but it seems that the DOS console at
+ * least is smart enough to handle _O_BINARY stdout and
+ * still display correctly.
+ */
+ if (stdin)
+ {
+ _setmode (_fileno (stdin), _CRT_fmode);
+ }
+ if (stdout)
+ {
+ _setmode (_fileno (stdout), _CRT_fmode);
+ }
+ if (stderr)
+ {
+ _setmode (_fileno (stderr), _CRT_fmode);
+ }
+ }
+}
+
+/* This function will be called when a trap occurs. Thanks to Jacob
+ Navia for his contribution. */
+static CALLBACK long
+_gnu_exception_handler (EXCEPTION_POINTERS * exception_data)
+{
+ void (*old_handler) (int);
+ long action = EXCEPTION_CONTINUE_SEARCH;
+ int reset_fpu = 0;
+
+ switch (exception_data->ExceptionRecord->ExceptionCode)
+ {
+ case EXCEPTION_ACCESS_VIOLATION:
+ /* test if the user has set SIGSEGV */
+ old_handler = signal (SIGSEGV, SIG_DFL);
+ if (old_handler == SIG_IGN)
+ {
+ /* this is undefined if the signal was raised by anything other
+ than raise (). */
+ signal (SIGSEGV, SIG_IGN);
+ action = EXCEPTION_CONTINUE_EXECUTION;
+ }
+ else if (old_handler != SIG_DFL)
+ {
+ /* This means 'old' is a user defined function. Call it */
+ (*old_handler) (SIGSEGV);
+ action = EXCEPTION_CONTINUE_EXECUTION;
+ }
+ break;
+
+ case EXCEPTION_FLT_INVALID_OPERATION:
+ case EXCEPTION_FLT_DIVIDE_BY_ZERO:
+ case EXCEPTION_FLT_DENORMAL_OPERAND:
+ case EXCEPTION_FLT_OVERFLOW:
+ case EXCEPTION_FLT_UNDERFLOW:
+ case EXCEPTION_FLT_INEXACT_RESULT:
+ reset_fpu = 1;
+ /* fall through. */
+
+ case EXCEPTION_INT_DIVIDE_BY_ZERO:
+ /* test if the user has set SIGFPE */
+ old_handler = signal (SIGFPE, SIG_DFL);
+ if (old_handler == SIG_IGN)
+ {
+ signal (SIGFPE, SIG_IGN);
+ if (reset_fpu)
+ _fpreset ();
+ action = EXCEPTION_CONTINUE_EXECUTION;
+ }
+ else if (old_handler != SIG_DFL)
+ {
+ /* This means 'old' is a user defined function. Call it */
+ (*old_handler) (SIGFPE);
+ action = EXCEPTION_CONTINUE_EXECUTION;
+ }
+ break;
+
+ default:
+ break;
+ }
+ return action;
+}
+
+/*
+ * The function mainCRTStartup is the entry point for all console programs.
+ */
+static int
+__mingw_CRTStartup ()
+{
+ int nRet;
+
+ /*
+ * Set up the top-level exception handler so that signal handling
+ * works as expected. The mapping between ANSI/POSIX signals and
+ * Win32 SE is not 1-to-1, so caveat emptore.
+ *
+ */
+ SetUnhandledExceptionFilter (_gnu_exception_handler);
+
+ /*
+ * Initialize floating point unit.
+ */
+ _fpreset (); /* Supplied by the runtime library. */
+
+ /*
+ * Set up __argc, __argv and _environ.
+ */
+ _mingw32_init_mainargs ();
+
+ /*
+ * Sets the default file mode for stdin, stdout and stderr, as well
+ * as files later opened by the user, to _CRT_fmode.
+ * NOTE: DLLs don't do this because that would be rude!
+ */
+ _mingw32_init_fmode ();
+
+ /*
+ * Call the main function. If the user does not supply one
+ * the one in the 'libmingw32.a' library will be linked in, and
+ * that one calls WinMain. See main.c in the 'lib' dir
+ * for more details.
+ */
+ nRet = main (_argc, _argv, environ);
+
+ /*
+ * Perform exit processing for the C library. This means
+ * flushing output and calling 'atexit' registered functions.
+ */
+ _cexit ();
+
+ ExitProcess (nRet);
+
+ return 0;
+}
+
+/*
+ * The function mainCRTStartup is the entry point for all console programs.
+ */
+int
+mainCRTStartup ()
+{
+#ifdef __MSVCRT__
+ __set_app_type (__CONSOLE_APP);
+#endif
+ __mingw_CRTStartup ();
+ return 0;
+}
+
+/*
+ * For now the GUI startup function is the same as the console one.
+ * This simply gets rid of the annoying warning about not being able
+ * to find WinMainCRTStartup when linking GUI applications.
+ */
+int
+WinMainCRTStartup ()
+{
+#ifdef __MSVCRT__
+ __set_app_type (__GUI_APP);
+#endif
+ __mingw_CRTStartup ();
+}
+
+#elif defined(DLLSTARTUP) /* dllcrt0.o - startup for a DLL */
+
+/* Unlike normal crt1, I don't initialize the FPU, because the process
+ * should have done that already. I also don't set the file handle modes,
+ * because that would be rude. */
+
+#ifdef __GNUC__
+extern void __main ();
+extern void __do_global_dtors ();
+#endif
+
+extern BOOL WINAPI DllMain (HANDLE, DWORD, LPVOID);
+
+BOOL WINAPI
+DllMainCRTStartup (HANDLE hDll, DWORD dwReason, LPVOID lpReserved)
+{
+ BOOL bRet;
+
+ if (dwReason == DLL_PROCESS_ATTACH)
+ {
+ _mingw32_init_mainargs ();
+
+#ifdef __GNUC__
+ /* From libgcc.a, calls global class constructors. */
+ __main ();
+#endif
+ }
+
+ /*
+ * Call the user-supplied DllMain subroutine
+ * NOTE: DllMain is optional, so libmingw32.a includes a stub
+ * which will be used if the user does not supply one.
+ */
+ bRet = DllMain (hDll, dwReason, lpReserved);
+
+#ifdef __GNUC__
+ if (dwReason == DLL_PROCESS_DETACH)
+ {
+ /* From libgcc.a, calls global class destructors. */
+ __do_global_dtors ();
+ }
+#endif
+
+ return bRet;
+}
+
+/*
+ * For the moment a dummy atexit. Atexit causes problems in DLLs, especially
+ * if they are dynamically loaded. For now atexit inside a DLL does nothing.
+ * NOTE: We need this even if the DLL author never calls atexit because
+ * the global constructor function __do_global_ctors called from __main
+ * will attempt to register __do_global_dtors using atexit.
+ * Thanks to Andrey A. Smirnov for pointing this one out.
+ */
+int
+atexit (void (*pfn) ())
+{
+ return 0;
+}
+
+#else
+#error No startup target!
+#endif /* EXESTARTUP */
##
#
-# Set these to wherever you want "nmake install" to put your
+# Set these to wherever you want "dmake install" to put your
# newly built perl.
#
INST_DRV *= c:
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER *= \5.00562
+INST_VER *= \5.00563
#
# Comment this out if you DON'T want your perl installation to have
#USE_OBJECT *= define
#
+# XXX WARNING! This option currently undergoing changes. May be broken.
+#
+# Beginnings of interpreter cloning/threads: still rather rough, fails
+# tests. This should be enabled to get the fork() emulation. Do not
+# enable unless you know what you're doing!
+#
+#USE_ITHREADS *= define
+
+#
+# uncomment to enable the implicit "host" layer for all system calls
+# made by perl. This is needed and auto-enabled by USE_OBJECT above.
+#
+#USE_IMP_SYS *= define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 2.x
#CFG *= Debug
#
-# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
-# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
-# This currently requires VC 5.0 with Service Pack 3 or later.
+# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler
+# or GCC/Mingw32. Highly recommended. It has patches that fix known bugs in
+# MSVCRT.DLL. This currently requires VC 5.0 with Service Pack 3 or later
+# or GCC/Mingw32.
# Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/
# and follow the directions in the package to install.
#
#BUILDOPT += -DPERL_POLLUTE
#
-# enable this to test the File::Glob implementation of CORE::glob
+# enable this to disable the File::Glob implementation of CORE::glob
#
-#BUILDOPT += -DPERL_INTERNAL_GLOB
+#BUILDOPT += -DPERL_EXTERNAL_GLOB
+
+# Enabling this runs a cloned toplevel interpreter (fails tests)
+#BUILDOPT += -DTOP_CLONE
#
# specify semicolon-separated list of extra directories that modules will
PERL_MALLOC != undef
USE_THREADS != undef
USE_MULTI != undef
+USE_IMP_SYS != define
.ENDIF
PERL_MALLOC *= undef
USE_THREADS *= undef
+
+.IF "$(USE_THREADS)" == "define"
+USE_ITHREADS != undef
+.ENDIF
+
USE_MULTI *= undef
USE_OBJECT *= undef
+USE_ITHREADS *= undef
+USE_IMP_SYS *= undef
.IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef"
BUILDOPT += -DPERL_IMPLICIT_CONTEXT
.ENDIF
+.IF "$(USE_ITHREADS)" != "undef"
+BUILDOPT += -DUSE_ITHREADS
+.ENDIF
+
+.IF "$(USE_IMP_SYS)" != "undef"
+BUILDOPT += -DPERL_IMPLICIT_SYS
+.ENDIF
.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE
#
# Options
#
-RUNTIME =
+
+# GCC headers need to know that we're using MSVCRT (or a clone thereof)
+RUNTIME = -D__MSVCRT__
INCLUDES = -I$(COREDIR) -I.\include -I. -I..
DEFINES = -DWIN32 $(CRYPT_FLAG)
LOCDEFS = -DPERLDLL -DPERL_CORE
SUBSYS = console
CXX_FLAG = -xc++
-# crtdll doesn't define _wopen and friends
-#LIBC = -lcrtdll
-LIBC = -lmsvcrt
-LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 \
- -lmingw32 -lgcc -lmoldname $(LIBC) -lkernel32
+.IF "$(USE_PERLCRT)" == ""
+LIBCDLL = msvcrt.dll
+CRTIMPLIBS = $(OLDNAMES_A)
+.ELSE
+LIBCDLL = PerlCRT.dll
+CRTIMPLIBS = $(PERLCRT_A) $(OLDNAMES_A)
+.ENDIF
+
+LIBC = -l$(LIBCDLL:s/.dll//)
+GCCLIBS = -lmingw32 -lgcc
+
+# same libs as MSVC, but no -luuid32 or -lodbccp32 yet
+LIBFILES = $(GCCLIBS) $(CRYPT_LIB) $(LIBC) -loldnames -lkernel32 \
+ -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 \
+ -lole32 -loleaut32 -lnetapi32 -lwsock32 -lmpr -lwinmm \
+ -lversion -lodbc32
.IF "$(CFG)" == "Debug"
-OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING
+OPTIMIZE = -g $(RUNTIME) -DDEBUGGING
LINK_DBG = -g
.ELSE
OPTIMIZE = -g -O2 $(RUNTIME)
EXEOUT_FLAG = -o
LIBOUT_FLAG =
+# tack COREDIR on for perl build
+PRIV_LINK_FLAGS = -L"$(COREDIR)"
+
.ELSE
CC = cl
LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \
oldnames.lib kernel32.lib user32.lib gdi32.lib \
winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
- oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
- version.lib odbc32.lib odbccp32.lib
+ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib \
+ winmm.lib version.lib odbc32.lib odbccp32.lib
# we add LIBC here, since we may be using PerlCRT.dll
LIBFILES = $(LIBBASEFILES) $(LIBC)
BUILDOPT += -DPERL_OBJECT
.ENDIF
+CRTIMPLIBS *= __not_needed
+PERLCRT_A *= $(COREDIR)\libPerlCRT.a
+PERLCRT_DEF *= PerlCRT.def
+OLDNAMES_A *= $(COREDIR)\liboldnames.a
+OLDNAMES_DEF *= oldnames.def
+
CFLAGS_O = $(CFLAGS) $(BUILDOPT)
+# used to allow local linking flags that are not propogated into Config.pm
+# -- BKS, 11-15-1999
+PRIV_LINK_FLAGS *=
+BLINK_FLAGS = $(PRIV_LINK_FLAGS) $(LINK_FLAGS)
+
#################### do not edit below this line #######################
############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
$(o).dll:
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def
+ $(LINK32) -Tpd -ap $(BLINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def
$(IMPLIB) $(*B).lib $@
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -o $@ $(LINK_FLAGS) $< $(LIBFILES)
+ $(LINK32) -o $@ $(BLINK_FLAGS) $< $(LIBFILES)
$(IMPLIB) -def $(*B).def $(*B).a $@
.ELSE
$(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+ -out:$@ $(BLINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
.ENDIF
#
MINIPERL = ..\miniperl.exe
MINIDIR = .\mini
PERLEXE = ..\perl.exe
+WPERLEXE = ..\wperl.exe
GLOBEXE = ..\perlglob.exe
CONFIGPM = ..\lib\Config.pm
MINIMOD = ..\lib\ExtUtils\Miniperl.pm
..\utils\c2ph \
..\utils\h2xs \
..\utils\perldoc \
- ..\utils\pstruct \
..\utils\perlcc \
..\pod\checkpods \
..\pod\pod2html \
.\include\dirent.h \
.\include\netdb.h \
.\include\sys\socket.h \
- .\win32.h
+ .\win32.h \
+ .\perlhost.h \
+ .\vdir.h \
+ .\vmem.h
CORE_H = $(CORE_NOCFG_H) .\config.h
PERLDLL_OBJ = $(CORE_OBJ)
PERLEXE_OBJ = perlmain$(o)
+.IF "$(CCTYPE)" == "GCC"
+PERLEXE_OBJ += .\gcrt0$(o)
+MINI_OBJ += $(MINIDIR)\gcrt0$(o)
+DLL_OBJ += .\gdllcrt0$(o)
+.ENDIF
+
PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ)
.IF "$(USE_SETARGV)" != ""
POD2LATEX = $(PODDIR)\pod2latex
POD2TEXT = $(PODDIR)\pod2text
+# vars must be separated by "\t+~\t+", since we're using the tempfile
+# version of config_sh.pl (we were overflowing someone's buffer by
+# trying to fit them all on the command line)
+# -- BKS 10-17-1999
CFG_VARS = \
- "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" \
- "INST_VER=$(INST_VER)" \
- "INST_ARCH=$(INST_ARCH)" \
- "archname=$(ARCHNAME)" \
- "cc=$(CC)" \
- "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(BUILDOPT)" \
- "cf_email=$(EMAIL)" \
- "d_crypt=$(D_CRYPT)" \
- "d_mymalloc=$(PERL_MALLOC)" \
- "libs=$(LIBFILES:f)" \
- "incpath=$(CCINCDIR:s/"/\"/)" \
- "libperl=$(PERLIMPLIB:f)" \
- "libpth=$(CCLIBDIR:s/"/\"/);$(EXTRALIBDIRS:s/"/\"/)" \
- "libc=$(LIBC)" \
- "make=dmake" \
- "_o=$(o)" "obj_ext=$(o)" \
- "_a=$(a)" "lib_ext=$(a)" \
- "static_ext=$(STATIC_EXT)" \
- "dynamic_ext=$(DYNAMIC_EXT)" \
- "nonxs_ext=$(NONXS_EXT)" \
- "usethreads=$(USE_THREADS)" \
- "usemultiplicity=$(USE_MULTI)" \
- "LINK_FLAGS=$(LINK_FLAGS:s/"/\"/)" \
- "optimize=$(OPTIMIZE:s/"/\"/)"
+ INST_DRV=$(INST_DRV) ~ \
+ INST_TOP=$(INST_TOP) ~ \
+ INST_VER=$(INST_VER:s/\/\\/) ~ \
+ INST_ARCH=$(INST_ARCH) ~ \
+ archname=$(ARCHNAME) ~ \
+ cc=$(CC) ~ \
+ ccflags=$(OPTIMIZE) $(DEFINES) $(BUILDOPT) ~ \
+ cf_email=$(EMAIL) ~ \
+ d_crypt=$(D_CRYPT) ~ \
+ d_mymalloc=$(PERL_MALLOC) ~ \
+ libs=$(LIBFILES:f) ~ \
+ incpath=$(CCINCDIR) ~ \
+ libperl=$(PERLIMPLIB:f) ~ \
+ libpth=$(CCLIBDIR);$(EXTRALIBDIRS) ~ \
+ libc=$(LIBC) ~ \
+ make=dmake ~ \
+ _o=$(o) obj_ext=$(o) ~ \
+ _a=$(a) lib_ext=$(a) ~ \
+ static_ext=$(STATIC_EXT) ~ \
+ dynamic_ext=$(DYNAMIC_EXT) ~ \
+ nonxs_ext=$(NONXS_EXT) ~ \
+ usethreads=$(USE_THREADS) ~ \
+ usemultiplicity=$(USE_MULTI) ~ \
+ LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \
+ optimize=$(OPTIMIZE)
+
+#
+# set up targets varying between Win95 and WinNT builds
+#
+
+.IF "$(IS_WIN95)" == "define"
+MK2 = .\makefile.95
+RIGHTMAKE = __switch_makefiles
+NOOP = @rem
+.ELSE
+MK2 = __not_needed
+RIGHTMAKE = __not_needed
+.ENDIF
#
# Top targets
#
-.IF "$(IS_WIN95)" != ""
-MK2 = .\makew95.mk
+all : $(CRTIMPLIBS) .\config.h $(GLOBEXE) $(MINIPERL) $(MK2) \
+ $(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
+ $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+
+$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
+
+#----------------------------------------------------------------
-all : .\config.h $(GLOBEXE) $(MINIMOD) $(MK2)
-all2 : $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) $(EXTENSION_DLL) \
- $(EXTENSIOM_PM)
+#-------------------- BEGIN Win95 SPECIFIC ----------------------
+
+# this target is a jump-off point for Win95
+# 1. it switches to the Win95-specific makefile if it exists
+# (__do_switc_makefiles)
+# 2. it prints a message when the Win95-specific one finishes (__done)
+# 3. it then kills this makefile by trying to make __no_such_target
+
+__switch_makefiles: __do_switch_makefiles __done __no_such_target
+
+__do_switch_makefiles:
+.IF "$(NOTFIRST)" != "true"
+ if exist $(MK2) $(MAKE:s/-S//) -f $(MK2) $(MAKETARGETS) NOTFIRST=true
.ELSE
-all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
- $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+ $(NOOP)
.ENDIF
-$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
+.IF "$(NOTFIRST)" != "true"
+__done:
+ @echo Build process complete. Ignore any errors after this message.
+ @echo Run "dmake test" to test and "dmake install" to install
-#------------------------------------------------------------
+.ELSE
+# dummy targets for Win95-specific makefile
+
+__done:
+ $(NOOP)
+
+__no_such_target:
+ $(NOOP)
-# This target is used to generate the makew95.mk for Win95
-.IF "$(IS_WIN95)" != ""
-$(MK2): makefile.mk
- $(MINIPERL) genmk95.pl makefile.mk $(MK2)
- $(MAKE) -f $(MK2) all2
.ENDIF
+# This target is used to generate the new makefile (.\makefile.95) for Win95
+
+.\makefile.95: .\makefile.mk
+ $(MINIPERL) genmk95.pl makefile.mk $(MK2)
+
+#--------------------- END Win95 SPECIFIC ---------------------
+
+#--------------------- BEGIN GCC/Mingw32 SPECIFIC -------------
+
+# make GCC-ish implib for PerlCRT.dll if needed
+$(PERLCRT_A): $(PERLCRT_DEF)
+ if not exist $(COREDIR) mkdir $(COREDIR)
+ $(IMPLIB) --def $(PERLCRT_DEF) \
+ --dllname $(LIBCDLL) \
+ --output-lib $(PERLCRT_A)
+
+# make GCC-ish oldnames implib for our CRT (whether it's MSVCRT or PerlCRT)
+$(OLDNAMES_A): $(OLDNAMES_DEF)
+ $(IMPLIB) --def $(OLDNAMES_DEF) \
+ --dllname $(LIBCDLL) \
+ --output-lib $(OLDNAMES_A) \
+ --add-underscore
+
+# MSVCRT-using runtime startup files
+$(MINIDIR)\gcrt0$(o): .\gstartup.c
+ $(CC) -c $(CFLAGS) -DEXESTARTUP $(OBJOUT_FLAG)$@ .\gstartup.c
+
+.\gcrt0$(o): .\gstartup.c
+ $(CC) -c $(CFLAGS) -DEXESTARTUP $(OBJOUT_FLAG)$@ .\gstartup.c
+
+.\gdllcrt0$(o): .\gstartup.c
+ $(CC) -c $(CFLAGS) -DDLLSTARTUP $(OBJOUT_FLAG)$@ .\gstartup.c
+ $(XCOPY) $@ $(COREDIR)
+
+
+#--------------------- END GCC/Mingw32 SPECIFIC ---------------
+
+# a blank target for when builds don't need to do certain things
+# this target added for Win95 port but used to keep the WinNT port able to
+# use this file
+__not_needed:
+ $(NOOP)
+
$(GLOBEXE) : perlglob$(o)
.IF "$(CCTYPE)" == "BORLAND"
$(CC) -c -w -v -tWM -I"$(CCINCDIR)" perlglob.c
- $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) c0x32$(o) perlglob$(o) \
"$(CCLIBDIR)\32BIT\wildargs$(o)",$@,,import32.lib cw32mt.lib,
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
+ $(LINK32) $(BLINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
.ELSE
- $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
+ $(LINK32) $(BLINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
perlglob$(o) setargv$(o)
.ENDIF
copy $(CFGH_TMPL) config.h
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
+ $(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file \
+ $(mktmp $(CFG_VARS)) config.w32 > ..\config.sh
# this target is for when changes to the main config.sh happen
# edit config.{b,v,g}c and make this target once for each supported
$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
$(RCOPY) include $(COREDIR)\*.*
$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
- || $(MAKE) $(MAKEMACROS) $(CONFIGPM)
+ || $(MAKE) $(MAKEMACROS) $(CONFIGPM) $(MAKEFILE)
-$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
+$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) $(CRTIPMLIBS)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -v -o $@ $(LINK_FLAGS) \
- $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
+ $(LINK32) -v -nostdlib -o $@ $(BLINK_FLAGS) \
+ $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\))
.ENDIF
$(MINIDIR) :
if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
$(MINICORE_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c
+ $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*B).c
$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c
+# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
+.IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef"
+perllib$(o) : perllib.c
+ $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
+.ENDIF
+
# 1. we don't want to rebuild miniperl.exe when config.h changes
# 2. we don't want to rebuild miniperl.exe with non-default config.h
$(MINI_OBJ) : $(CORE_NOCFG_H)
$(X2P_OBJ) : $(CORE_H)
perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
- $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
- CCTYPE=$(CCTYPE) > perldll.def
+ $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \
+ $(BUILDOPT) CCTYPE=$(CCTYPE) > perldll.def
$(PERLDLL): perldll.def $(PERLDLL_OBJ)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpd -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpd -ap $(BLINK_FLAGS) \
@$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \
$@,\n \
$(LIBFILES)\n \
perldll.def\n)
$(IMPLIB) $*.lib $@
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \
+ $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
dlltool --output-lib $(PERLIMPLIB) \
- --dllname perl.dll \
+ --dllname $(PERLDLL:b).dll \
--def perldll.def \
--base-file perl.base \
--output-exp perl.exp
- $(LINK32) -mdll -o $@ $(LINK_FLAGS) \
+ $(LINK32) -mdll -o $@ $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \
perl.exp $(LKPOST))
.ELSE
$(LINK32) -dll -def:perldll.def -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\))
.ENDIF
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
$(MINIPERL) ..\x2p\find2perl.PL
$(MINIPERL) ..\x2p\s2p.PL
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(X2P_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -v -o $@ $(LINK_FLAGS) \
+ $(LINK32) -v -o $@ $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(X2P_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\))
.ENDIF
perlmain.c : runperl.c
$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(PERLEXE_OBJ:s,\,\\)\n \
$(@:s,\,\\),\n \
$(PERLIMPLIB) $(LIBFILES)\n)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -o $@ $(LINK_FLAGS) \
+ $(LINK32) -nostdlib -o $@ $(BLINK_FLAGS) \
$(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES)
.ELSE
- $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
+ $(LINK32) -subsystem:console -out:$@ $(BLINK_FLAGS) $(LIBFILES) \
$(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+ copy $(PERLEXE) $(WPERLEXE)
+ editbin /subsystem:windows $(WPERLEXE)
.ENDIF
copy splittree.pl ..
$(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
$(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
- $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
+ $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(BLINK_FLAGS) \
$(LIBBASEFILES) $(PERL95_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) \
libcmt.lib
$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
if not exist $(AUTODIR) mkdir $(AUTODIR)
cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
$(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
-del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
-del /f $(EXTDIR)\DynaLoader\dl_win32.xs
-del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\XSLoader.pm
-del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \
- dprofpp pstruct *.bat
+ dprofpp *.bat
-cd ..\x2p && del /f find2perl s2p *.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
install : all installbare installhtml
-installbare : utils
+installbare : $(RIGHTMAKE) utils
$(PERLEXE) ..\installperl
.IF "$(PERL95EXE)" != ""
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
.ENDIF
+ if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
$(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
$(XCOPY) $(GLOBEXE) ..\t\$(NULL)
.ENDIF
-test : test-prep
+test : $(RIGHTMAKE) test-prep
cd ..\t && $(PERLEXE) -I..\lib harness
test-notty : test-prep
-@erase /f config.h
-@erase $(GLOBEXE)
-@erase $(PERLEXE)
+ -@erase $(WPERLEXE)
-@erase $(PERLDLL)
-@erase $(CORE_OBJ)
-rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
--- /dev/null
+;
+; oldnames.def
+;
+; oldnames versions of MSVCRT/PerlCRT functions for GCC/Mingw32
+;
+; This file is taken from the Mingw32 distribution
+; Created by Colin Peters for Mingw32
+;
+; Added to Perl5 distrbution by Benjamin Stuhl <sho_pi@hotmail.com>
+
+EXPORTS
+access
+beep
+cabs
+chdir
+chmod
+chsize
+close
+creat
+cwait
+dup
+dup2
+ecvt
+eof
+execl
+execle
+execlp
+execlpe
+execv
+execve
+execvp
+execvpe
+fcvt
+fdopen
+fgetchar
+fgetwchar
+filelength
+fileno
+fputchar
+fputwchar
+fstat
+ftime
+gcvt
+getch
+getche
+getcwd
+getpid
+getw
+heapwalk
+hypot
+isatty
+itoa
+j0
+j1
+jn
+kbhit
+lseek
+ltoa
+memccpy
+memicmp
+mkdir
+mktemp
+open
+pclose
+popen
+putch
+putenv
+putw
+read
+rmdir
+searchenv
+seterrormode
+setmode
+sleep
+sopen
+spawnl
+spawnle
+spawnlp
+spawnlpe
+spawnv
+spawnve
+spawnvp
+spawnvpe
+stat
+strcmpi
+strdup
+stricmp
+stricoll
+strlwr
+strnicmp
+strnset
+strrev
+strset
+strupr
+swab
+tell
+tempnam
+tzset
+umask
+ungetch
+unlink
+utime
+wcsdup
+wcsicmp
+wcsicoll
+wcslwr
+wcsnicmp
+wcsnset
+wcsrev
+wcsset
+wcsupr
+write
+y0
+y1
+yn
--- /dev/null
+/* perlhost.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ */
+
+#ifndef ___PerlHost_H___
+#define ___PerlHost_H___
+
+#include "iperlsys.h"
+#include "vmem.h"
+#include "vdir.h"
+
+#if !defined(PERL_OBJECT)
+START_EXTERN_C
+#endif
+extern char * g_win32_get_privlib(char *pl);
+extern char * g_win32_get_sitelib(char *pl);
+extern char * g_getlogin(void);
+extern int do_spawn2(char *cmd, int exectype);
+#if !defined(PERL_OBJECT)
+END_EXTERN_C
+#endif
+
+#ifdef PERL_OBJECT
+extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
+#define do_aspawn g_do_aspawn
+#endif
+
+class CPerlHost
+{
+public:
+ CPerlHost(void);
+ CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc);
+ CPerlHost(CPerlHost& host);
+ ~CPerlHost(void);
+
+ static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
+ static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
+ static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
+ static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
+ static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
+ static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
+
+ BOOL PerlCreate(void);
+ int PerlParse(int argc, char** argv, char** env);
+ int PerlRun(void);
+ void PerlDestroy(void);
+
+/* IPerlMem */
+ inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
+ inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
+ inline void Free(void* ptr) { m_pVMem->Free(ptr); };
+ inline void* Calloc(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = Malloc(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLock(void) { m_pVMem->GetLock(); };
+ inline void FreeLock(void) { m_pVMem->FreeLock(); };
+ inline int IsLocked(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlMemShared */
+ inline void* MallocShared(size_t size)
+ {
+ return m_pVMemShared->Malloc(size);
+ };
+ inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
+ inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
+ inline void* CallocShared(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = MallocShared(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLockShared(void) { m_pVMem->GetLock(); };
+ inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
+ inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlMemParse */
+ inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
+ inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
+ inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
+ inline void* CallocParse(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = MallocParse(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLockParse(void) { m_pVMem->GetLock(); };
+ inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
+ inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlEnv */
+ char *Getenv(const char *varname);
+ int Putenv(const char *envstring);
+ inline char *Getenv(const char *varname, unsigned long *len)
+ {
+ *len = 0;
+ char *e = Getenv(varname);
+ if (e)
+ *len = strlen(e);
+ return e;
+ }
+ void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
+ void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
+ char* GetChildDir(void);
+ void FreeChildDir(char* pStr);
+ void Reset(void);
+ void Clearenv(void);
+
+ inline LPSTR GetIndex(DWORD &dwIndex)
+ {
+ if(dwIndex < m_dwEnvCount)
+ {
+ ++dwIndex;
+ return m_lppEnvList[dwIndex-1];
+ }
+ return NULL;
+ };
+
+protected:
+ LPSTR Find(LPCSTR lpStr);
+ void Add(LPCSTR lpStr);
+
+ LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
+ void FreeLocalEnvironmentStrings(LPSTR lpStr);
+ LPSTR* Lookup(LPCSTR lpStr);
+ DWORD CalculateEnvironmentSpace(void);
+
+public:
+
+/* IPerlDIR */
+ virtual int Chdir(const char *dirname);
+
+/* IPerllProc */
+ void Abort(void);
+ void Exit(int status);
+ void _Exit(int status);
+ int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
+ int Execv(const char *cmdname, const char *const *argv);
+ int Execvp(const char *cmdname, const char *const *argv);
+
+ inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
+ inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
+ inline VDir* GetDir(void) { return m_pvDir; };
+
+public:
+
+ struct IPerlMem m_hostperlMem;
+ struct IPerlMem m_hostperlMemShared;
+ struct IPerlMem m_hostperlMemParse;
+ struct IPerlEnv m_hostperlEnv;
+ struct IPerlStdIO m_hostperlStdIO;
+ struct IPerlLIO m_hostperlLIO;
+ struct IPerlDir m_hostperlDir;
+ struct IPerlSock m_hostperlSock;
+ struct IPerlProc m_hostperlProc;
+
+ struct IPerlMem* m_pHostperlMem;
+ struct IPerlMem* m_pHostperlMemShared;
+ struct IPerlMem* m_pHostperlMemParse;
+ struct IPerlEnv* m_pHostperlEnv;
+ struct IPerlStdIO* m_pHostperlStdIO;
+ struct IPerlLIO* m_pHostperlLIO;
+ struct IPerlDir* m_pHostperlDir;
+ struct IPerlSock* m_pHostperlSock;
+ struct IPerlProc* m_pHostperlProc;
+
+ inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
+ inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
+protected:
+
+ VDir* m_pvDir;
+ VMem* m_pVMem;
+ VMem* m_pVMemShared;
+ VMem* m_pVMemParse;
+
+ DWORD m_dwEnvCount;
+ LPSTR* m_lppEnvList;
+};
+
+
+#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
+
+inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMem);
+}
+
+inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMemShared);
+}
+
+inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMemParse);
+}
+
+inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlEnv);
+}
+
+inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlStdIO);
+}
+
+inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlLIO);
+}
+
+inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlDir);
+}
+
+inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlSock);
+}
+
+inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlProc);
+}
+
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMem2Host(x)
+
+/* IPerlMem */
+void*
+PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->Malloc(size);
+}
+void*
+PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->Realloc(ptr, size);
+}
+void
+PerlMemFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->Free(ptr);
+}
+void*
+PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->Calloc(num, size);
+}
+
+void
+PerlMemGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLock();
+}
+
+void
+PerlMemFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLock();
+}
+
+int
+PerlMemIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLocked();
+}
+
+struct IPerlMem perlMem =
+{
+ PerlMemMalloc,
+ PerlMemRealloc,
+ PerlMemFree,
+ PerlMemCalloc,
+ PerlMemGetLock,
+ PerlMemFreeLock,
+ PerlMemIsLocked,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMemShared2Host(x)
+
+/* IPerlMemShared */
+void*
+PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->MallocShared(size);
+}
+void*
+PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
+}
+void
+PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->FreeShared(ptr);
+}
+void*
+PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->CallocShared(num, size);
+}
+
+void
+PerlMemSharedGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLockShared();
+}
+
+void
+PerlMemSharedFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLockShared();
+}
+
+int
+PerlMemSharedIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLockedShared();
+}
+
+struct IPerlMem perlMemShared =
+{
+ PerlMemSharedMalloc,
+ PerlMemSharedRealloc,
+ PerlMemSharedFree,
+ PerlMemSharedCalloc,
+ PerlMemSharedGetLock,
+ PerlMemSharedFreeLock,
+ PerlMemSharedIsLocked,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMemParse2Host(x)
+
+/* IPerlMemParse */
+void*
+PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->MallocParse(size);
+}
+void*
+PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
+}
+void
+PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->FreeParse(ptr);
+}
+void*
+PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->CallocParse(num, size);
+}
+
+void
+PerlMemParseGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLockParse();
+}
+
+void
+PerlMemParseFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLockParse();
+}
+
+int
+PerlMemParseIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLockedParse();
+}
+
+struct IPerlMem perlMemParse =
+{
+ PerlMemParseMalloc,
+ PerlMemParseRealloc,
+ PerlMemParseFree,
+ PerlMemParseCalloc,
+ PerlMemParseGetLock,
+ PerlMemParseFreeLock,
+ PerlMemParseIsLocked,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlEnv2Host(x)
+
+/* IPerlEnv */
+char*
+PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
+{
+ return IPERL2HOST(piPerl)->Getenv(varname);
+};
+
+int
+PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
+{
+ return IPERL2HOST(piPerl)->Putenv(envstring);
+};
+
+char*
+PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
+{
+ return IPERL2HOST(piPerl)->Getenv(varname, len);
+}
+
+int
+PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
+{
+ return win32_uname(name);
+}
+
+void
+PerlEnvClearenv(struct IPerlEnv* piPerl)
+{
+ IPERL2HOST(piPerl)->Clearenv();
+}
+
+void*
+PerlEnvGetChildenv(struct IPerlEnv* piPerl)
+{
+ return IPERL2HOST(piPerl)->CreateChildEnv();
+}
+
+void
+PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
+{
+ IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
+}
+
+char*
+PerlEnvGetChilddir(struct IPerlEnv* piPerl)
+{
+ return IPERL2HOST(piPerl)->GetChildDir();
+}
+
+void
+PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
+{
+ IPERL2HOST(piPerl)->FreeChildDir(childDir);
+}
+
+unsigned long
+PerlEnvOsId(struct IPerlEnv* piPerl)
+{
+ return win32_os_id();
+}
+
+char*
+PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
+{
+ return g_win32_get_privlib(pl);
+}
+
+char*
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
+{
+ return g_win32_get_sitelib(pl);
+}
+
+struct IPerlEnv perlEnv =
+{
+ PerlEnvGetenv,
+ PerlEnvPutenv,
+ PerlEnvGetenv_len,
+ PerlEnvUname,
+ PerlEnvClearenv,
+ PerlEnvGetChildenv,
+ PerlEnvFreeChildenv,
+ PerlEnvGetChilddir,
+ PerlEnvFreeChilddir,
+ PerlEnvOsId,
+ PerlEnvLibPath,
+ PerlEnvSiteLibPath,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlStdIO2Host(x)
+
+/* PerlStdIO */
+PerlIO*
+PerlStdIOStdin(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stdin();
+}
+
+PerlIO*
+PerlStdIOStdout(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stdout();
+}
+
+PerlIO*
+PerlStdIOStderr(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stderr();
+}
+
+PerlIO*
+PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
+{
+ return (PerlIO*)win32_fopen(path, mode);
+}
+
+int
+PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fclose(((FILE*)pf));
+}
+
+int
+PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_feof((FILE*)pf);
+}
+
+int
+PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_ferror((FILE*)pf);
+}
+
+void
+PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_clearerr((FILE*)pf);
+}
+
+int
+PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_getc((FILE*)pf);
+}
+
+char*
+PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef FILE_base
+ FILE *f = (FILE*)pf;
+ return FILE_base(f);
+#else
+ return Nullch;
+#endif
+}
+
+int
+PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef FILE_bufsiz
+ FILE *f = (FILE*)pf;
+ return FILE_bufsiz(f);
+#else
+ return (-1);
+#endif
+}
+
+int
+PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+ FILE *f = (FILE*)pf;
+ return FILE_cnt(f);
+#else
+ return (-1);
+#endif
+}
+
+char*
+PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+ FILE *f = (FILE*)pf;
+ return FILE_ptr(f);
+#else
+ return Nullch;
+#endif
+}
+
+char*
+PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
+{
+ return win32_fgets(s, n, (FILE*)pf);
+}
+
+int
+PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
+{
+ return win32_fputc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
+{
+ return win32_fputs(s, (FILE*)pf);
+}
+
+int
+PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fflush((FILE*)pf);
+}
+
+int
+PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
+{
+ return win32_ungetc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fileno((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
+{
+ return (PerlIO*)win32_fdopen(fd, mode);
+}
+
+PerlIO*
+PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
+{
+ return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
+{
+ return win32_fread(buffer, 1, size, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
+{
+ return win32_fwrite(buffer, 1, size, (FILE*)pf);
+}
+
+void
+PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
+{
+ win32_setbuf((FILE*)pf, buffer);
+}
+
+int
+PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
+{
+ return win32_setvbuf((FILE*)pf, buffer, type, size);
+}
+
+void
+PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
+{
+#ifdef STDIO_CNT_LVALUE
+ FILE *f = (FILE*)pf;
+ FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
+{
+#ifdef STDIO_PTR_LVALUE
+ FILE *f = (FILE*)pf;
+ FILE_ptr(f) = ptr;
+ FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+}
+
+int
+PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
+{
+ va_list(arglist);
+ va_start(arglist, format);
+ return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+int
+PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
+{
+ return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+long
+PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_ftell((FILE*)pf);
+}
+
+int
+PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
+{
+ return win32_fseek((FILE*)pf, offset, origin);
+}
+
+void
+PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_rewind((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_tmpfile();
+}
+
+int
+PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
+{
+ return win32_fgetpos((FILE*)pf, p);
+}
+
+int
+PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
+{
+ return win32_fsetpos((FILE*)pf, p);
+}
+void
+PerlStdIOInit(struct IPerlStdIO* piPerl)
+{
+}
+
+void
+PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
+{
+ Perl_init_os_extras();
+}
+
+int
+PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
+{
+ return win32_open_osfhandle(osfhandle, flags);
+}
+
+int
+PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
+{
+ return win32_get_osfhandle(filenum);
+}
+
+PerlIO*
+PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ PerlIO* pfdup;
+ fpos_t pos;
+ char mode[3];
+ int fileno = win32_dup(win32_fileno((FILE*)pf));
+
+ /* open the file in the same mode */
+#ifdef __BORLANDC__
+ if(((FILE*)pf)->flags & _F_READ) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->flags & _F_WRIT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->flags & _F_RDWR) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#else
+ if(((FILE*)pf)->_flag & _IOREAD) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->_flag & _IOWRT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->_flag & _IORW) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#endif
+
+ /* it appears that the binmode is attached to the
+ * file descriptor so binmode files will be handled
+ * correctly
+ */
+ pfdup = (PerlIO*)win32_fdopen(fileno, mode);
+
+ /* move the file pointer to the same position */
+ if (!fgetpos((FILE*)pf, &pos)) {
+ fsetpos((FILE*)pfdup, &pos);
+ }
+ return pfdup;
+}
+
+struct IPerlStdIO perlStdIO =
+{
+ PerlStdIOStdin,
+ PerlStdIOStdout,
+ PerlStdIOStderr,
+ PerlStdIOOpen,
+ PerlStdIOClose,
+ PerlStdIOEof,
+ PerlStdIOError,
+ PerlStdIOClearerr,
+ PerlStdIOGetc,
+ PerlStdIOGetBase,
+ PerlStdIOGetBufsiz,
+ PerlStdIOGetCnt,
+ PerlStdIOGetPtr,
+ PerlStdIOGets,
+ PerlStdIOPutc,
+ PerlStdIOPuts,
+ PerlStdIOFlush,
+ PerlStdIOUngetc,
+ PerlStdIOFileno,
+ PerlStdIOFdopen,
+ PerlStdIOReopen,
+ PerlStdIORead,
+ PerlStdIOWrite,
+ PerlStdIOSetBuf,
+ PerlStdIOSetVBuf,
+ PerlStdIOSetCnt,
+ PerlStdIOSetPtrCnt,
+ PerlStdIOSetlinebuf,
+ PerlStdIOPrintf,
+ PerlStdIOVprintf,
+ PerlStdIOTell,
+ PerlStdIOSeek,
+ PerlStdIORewind,
+ PerlStdIOTmpfile,
+ PerlStdIOGetpos,
+ PerlStdIOSetpos,
+ PerlStdIOInit,
+ PerlStdIOInitOSExtras,
+ PerlStdIOFdupopen,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlLIO2Host(x)
+
+/* IPerlLIO */
+int
+PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
+{
+ return win32_access(path, mode);
+}
+
+int
+PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
+{
+ return win32_chmod(filename, pmode);
+}
+
+int
+PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
+{
+ return chown(filename, owner, group);
+}
+
+int
+PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
+{
+ return chsize(handle, size);
+}
+
+int
+PerlLIOClose(struct IPerlLIO* piPerl, int handle)
+{
+ return win32_close(handle);
+}
+
+int
+PerlLIODup(struct IPerlLIO* piPerl, int handle)
+{
+ return win32_dup(handle);
+}
+
+int
+PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
+{
+ return win32_dup2(handle1, handle2);
+}
+
+int
+PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
+{
+ return win32_flock(fd, oper);
+}
+
+int
+PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
+{
+ return fstat(handle, buffer);
+}
+
+int
+PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
+{
+ return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
+}
+
+int
+PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
+{
+ return isatty(fd);
+}
+
+int
+PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
+{
+ return win32_link(oldname, newname);
+}
+
+long
+PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
+{
+ return win32_lseek(handle, offset, origin);
+}
+
+int
+PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+{
+ return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
+{
+ return mktemp(Template);
+}
+
+int
+PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
+{
+ return win32_open(filename, oflag);
+}
+
+int
+PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
+{
+ return win32_open(filename, oflag, pmode);
+}
+
+int
+PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
+{
+ return win32_read(handle, buffer, count);
+}
+
+int
+PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
+{
+ return win32_rename(OldFileName, newname);
+}
+
+int
+PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
+{
+ return win32_setmode(handle, mode);
+}
+
+int
+PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+{
+ return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
+{
+ return tmpnam(string);
+}
+
+int
+PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
+{
+ return umask(pmode);
+}
+
+int
+PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
+{
+ return win32_unlink(filename);
+}
+
+int
+PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
+{
+ return win32_utime(filename, times);
+}
+
+int
+PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
+{
+ return win32_write(handle, buffer, count);
+}
+
+struct IPerlLIO perlLIO =
+{
+ PerlLIOAccess,
+ PerlLIOChmod,
+ PerlLIOChown,
+ PerlLIOChsize,
+ PerlLIOClose,
+ PerlLIODup,
+ PerlLIODup2,
+ PerlLIOFlock,
+ PerlLIOFileStat,
+ PerlLIOIOCtl,
+ PerlLIOIsatty,
+ PerlLIOLink,
+ PerlLIOLseek,
+ PerlLIOLstat,
+ PerlLIOMktemp,
+ PerlLIOOpen,
+ PerlLIOOpen3,
+ PerlLIORead,
+ PerlLIORename,
+ PerlLIOSetmode,
+ PerlLIONameStat,
+ PerlLIOTmpnam,
+ PerlLIOUmask,
+ PerlLIOUnlink,
+ PerlLIOUtime,
+ PerlLIOWrite,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlDir2Host(x)
+
+/* IPerlDIR */
+int
+PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
+{
+ return win32_mkdir(dirname, mode);
+}
+
+int
+PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
+{
+ return IPERL2HOST(piPerl)->Chdir(dirname);
+}
+
+int
+PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
+{
+ return win32_rmdir(dirname);
+}
+
+int
+PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_closedir(dirp);
+}
+
+DIR*
+PerlDirOpen(struct IPerlDir* piPerl, char *filename)
+{
+ return win32_opendir(filename);
+}
+
+struct direct *
+PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_readdir(dirp);
+}
+
+void
+PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
+{
+ win32_rewinddir(dirp);
+}
+
+void
+PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
+{
+ win32_seekdir(dirp, loc);
+}
+
+long
+PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_telldir(dirp);
+}
+
+char*
+PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
+{
+ return IPERL2HOST(piPerl)->MapPathA(path);
+}
+
+WCHAR*
+PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
+{
+ return IPERL2HOST(piPerl)->MapPathW(path);
+}
+
+struct IPerlDir perlDir =
+{
+ PerlDirMakedir,
+ PerlDirChdir,
+ PerlDirRmdir,
+ PerlDirClose,
+ PerlDirOpen,
+ PerlDirRead,
+ PerlDirRewind,
+ PerlDirSeek,
+ PerlDirTell,
+ PerlDirMapPathA,
+ PerlDirMapPathW,
+};
+
+
+/* IPerlSock */
+u_long
+PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
+{
+ return win32_htonl(hostlong);
+}
+
+u_short
+PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
+{
+ return win32_htons(hostshort);
+}
+
+u_long
+PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
+{
+ return win32_ntohl(netlong);
+}
+
+u_short
+PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
+{
+ return win32_ntohs(netshort);
+}
+
+SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
+{
+ return win32_accept(s, addr, addrlen);
+}
+
+int
+PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
+{
+ return win32_bind(s, name, namelen);
+}
+
+int
+PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
+{
+ return win32_connect(s, name, namelen);
+}
+
+void
+PerlSockEndhostent(struct IPerlSock* piPerl)
+{
+ win32_endhostent();
+}
+
+void
+PerlSockEndnetent(struct IPerlSock* piPerl)
+{
+ win32_endnetent();
+}
+
+void
+PerlSockEndprotoent(struct IPerlSock* piPerl)
+{
+ win32_endprotoent();
+}
+
+void
+PerlSockEndservent(struct IPerlSock* piPerl)
+{
+ win32_endservent();
+}
+
+struct hostent*
+PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
+{
+ return win32_gethostbyaddr(addr, len, type);
+}
+
+struct hostent*
+PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
+{
+ return win32_gethostbyname(name);
+}
+
+struct hostent*
+PerlSockGethostent(struct IPerlSock* piPerl)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "gethostent not implemented!\n");
+ return NULL;
+}
+
+int
+PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
+{
+ return win32_gethostname(name, namelen);
+}
+
+struct netent *
+PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
+{
+ return win32_getnetbyaddr(net, type);
+}
+
+struct netent *
+PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
+{
+ return win32_getnetbyname((char*)name);
+}
+
+struct netent *
+PerlSockGetnetent(struct IPerlSock* piPerl)
+{
+ return win32_getnetent();
+}
+
+int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
+{
+ return win32_getpeername(s, name, namelen);
+}
+
+struct protoent*
+PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
+{
+ return win32_getprotobyname(name);
+}
+
+struct protoent*
+PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
+{
+ return win32_getprotobynumber(number);
+}
+
+struct protoent*
+PerlSockGetprotoent(struct IPerlSock* piPerl)
+{
+ return win32_getprotoent();
+}
+
+struct servent*
+PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
+{
+ return win32_getservbyname(name, proto);
+}
+
+struct servent*
+PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
+{
+ return win32_getservbyport(port, proto);
+}
+
+struct servent*
+PerlSockGetservent(struct IPerlSock* piPerl)
+{
+ return win32_getservent();
+}
+
+int
+PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
+{
+ return win32_getsockname(s, name, namelen);
+}
+
+int
+PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
+{
+ return win32_getsockopt(s, level, optname, optval, optlen);
+}
+
+unsigned long
+PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
+{
+ return win32_inet_addr(cp);
+}
+
+char*
+PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
+{
+ return win32_inet_ntoa(in);
+}
+
+int
+PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
+{
+ return win32_listen(s, backlog);
+}
+
+int
+PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
+{
+ return win32_recv(s, buffer, len, flags);
+}
+
+int
+PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
+{
+ return win32_recvfrom(s, buffer, len, flags, from, fromlen);
+}
+
+int
+PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
+{
+ return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+}
+
+int
+PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
+{
+ return win32_send(s, buffer, len, flags);
+}
+
+int
+PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
+{
+ return win32_sendto(s, buffer, len, flags, to, tolen);
+}
+
+void
+PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_sethostent(stayopen);
+}
+
+void
+PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setnetent(stayopen);
+}
+
+void
+PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setprotoent(stayopen);
+}
+
+void
+PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setservent(stayopen);
+}
+
+int
+PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
+{
+ return win32_setsockopt(s, level, optname, optval, optlen);
+}
+
+int
+PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
+{
+ return win32_shutdown(s, how);
+}
+
+SOCKET
+PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
+{
+ return win32_socket(af, type, protocol);
+}
+
+int
+PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "socketpair not implemented!\n");
+ return 0;
+}
+
+int
+PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
+{
+ return win32_closesocket(s);
+}
+
+int
+PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
+{
+ return win32_ioctlsocket(s, cmd, argp);
+}
+
+struct IPerlSock perlSock =
+{
+ PerlSockHtonl,
+ PerlSockHtons,
+ PerlSockNtohl,
+ PerlSockNtohs,
+ PerlSockAccept,
+ PerlSockBind,
+ PerlSockConnect,
+ PerlSockEndhostent,
+ PerlSockEndnetent,
+ PerlSockEndprotoent,
+ PerlSockEndservent,
+ PerlSockGethostname,
+ PerlSockGetpeername,
+ PerlSockGethostbyaddr,
+ PerlSockGethostbyname,
+ PerlSockGethostent,
+ PerlSockGetnetbyaddr,
+ PerlSockGetnetbyname,
+ PerlSockGetnetent,
+ PerlSockGetprotobyname,
+ PerlSockGetprotobynumber,
+ PerlSockGetprotoent,
+ PerlSockGetservbyname,
+ PerlSockGetservbyport,
+ PerlSockGetservent,
+ PerlSockGetsockname,
+ PerlSockGetsockopt,
+ PerlSockInetAddr,
+ PerlSockInetNtoa,
+ PerlSockListen,
+ PerlSockRecv,
+ PerlSockRecvfrom,
+ PerlSockSelect,
+ PerlSockSend,
+ PerlSockSendto,
+ PerlSockSethostent,
+ PerlSockSetnetent,
+ PerlSockSetprotoent,
+ PerlSockSetservent,
+ PerlSockSetsockopt,
+ PerlSockShutdown,
+ PerlSockSocket,
+ PerlSockSocketpair,
+ PerlSockClosesocket,
+};
+
+
+/* IPerlProc */
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+void
+PerlProcAbort(struct IPerlProc* piPerl)
+{
+ win32_abort();
+}
+
+char *
+PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
+{
+ return win32_crypt(clear, salt);
+}
+
+void
+PerlProcExit(struct IPerlProc* piPerl, int status)
+{
+ exit(status);
+}
+
+void
+PerlProc_Exit(struct IPerlProc* piPerl, int status)
+{
+ _exit(status);
+}
+
+int
+PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+{
+ return execl(cmdname, arg0, arg1, arg2, arg3);
+}
+
+int
+PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+{
+ return win32_execvp(cmdname, argv);
+}
+
+int
+PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+{
+ return win32_execvp(cmdname, argv);
+}
+
+uid_t
+PerlProcGetuid(struct IPerlProc* piPerl)
+{
+ return getuid();
+}
+
+uid_t
+PerlProcGeteuid(struct IPerlProc* piPerl)
+{
+ return geteuid();
+}
+
+gid_t
+PerlProcGetgid(struct IPerlProc* piPerl)
+{
+ return getgid();
+}
+
+gid_t
+PerlProcGetegid(struct IPerlProc* piPerl)
+{
+ return getegid();
+}
+
+char *
+PerlProcGetlogin(struct IPerlProc* piPerl)
+{
+ return g_getlogin();
+}
+
+int
+PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
+{
+ return win32_kill(pid, sig);
+}
+
+int
+PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "killpg not implemented!\n");
+ return 0;
+}
+
+int
+PerlProcPauseProc(struct IPerlProc* piPerl)
+{
+ return win32_sleep((32767L << 16) + 32767);
+}
+
+PerlIO*
+PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
+{
+ dTHXo;
+ PERL_FLUSHALL_FOR_CHILD;
+ return (PerlIO*)win32_popen(command, mode);
+}
+
+int
+PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
+{
+ return win32_pclose((FILE*)stream);
+}
+
+int
+PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
+{
+ return win32_pipe(phandles, 512, O_BINARY);
+}
+
+int
+PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
+{
+ return setuid(u);
+}
+
+int
+PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
+{
+ return setgid(g);
+}
+
+int
+PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
+{
+ return win32_sleep(s);
+}
+
+int
+PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
+{
+ return win32_times(timebuf);
+}
+
+int
+PerlProcWait(struct IPerlProc* piPerl, int *status)
+{
+ return win32_wait(status);
+}
+
+int
+PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
+{
+ return win32_waitpid(pid, status, flags);
+}
+
+Sighandler_t
+PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
+{
+ return 0;
+}
+
+#ifdef USE_ITHREADS
+static DWORD WINAPI
+win32_start_child(LPVOID arg)
+{
+ PerlInterpreter *my_perl = (PerlInterpreter*)arg;
+ GV *tmpgv;
+ int status;
+#ifdef PERL_OBJECT
+ CPerlObj *pPerl = (CPerlObj*)my_perl;
+#endif
+#ifdef PERL_SYNC_FORK
+ static long sync_fork_id = 0;
+ long id = ++sync_fork_id;
+#endif
+
+
+ PERL_SET_INTERP(my_perl);
+
+ /* set $$ to pseudo id */
+#ifdef PERL_SYNC_FORK
+ w32_pseudo_id = id;
+#else
+ w32_pseudo_id = GetCurrentThreadId();
+#endif
+ if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
+ sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
+ hv_clear(PL_pidstatus);
+
+ /* push a zero on the stack (we are the child) */
+ {
+ djSP;
+ dTARGET;
+ PUSHi(0);
+ PUTBACK;
+ }
+
+ /* continue from next op */
+ PL_op = PL_op->op_next;
+
+ {
+ dJMPENV;
+ volatile oldscope = PL_scopestack_ix;
+
+restart:
+ JMPENV_PUSH(status);
+ switch (status) {
+ case 0:
+ CALLRUNOPS(aTHX);
+ status = 0;
+ break;
+ case 2:
+ while (PL_scopestack_ix > oldscope)
+ LEAVE;
+ FREETMPS;
+ PL_curstash = PL_defstash;
+ if (PL_endav && !PL_minus_c)
+ call_list(oldscope, PL_endav);
+ status = STATUS_NATIVE_EXPORT;
+ break;
+ case 3:
+ if (PL_restartop) {
+ POPSTACK_TO(PL_mainstack);
+ PL_op = PL_restartop;
+ PL_restartop = Nullop;
+ goto restart;
+ }
+ PerlIO_printf(Perl_error_log, "panic: restartop\n");
+ FREETMPS;
+ status = 1;
+ break;
+ }
+ JMPENV_POP;
+
+ /* XXX hack to avoid perl_destruct() freeing optree */
+ PL_main_root = Nullop;
+ }
+
+ /* destroy everything (waits for any pseudo-forked children) */
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+
+#ifdef PERL_SYNC_FORK
+ return id;
+#else
+ return (DWORD)status;
+#endif
+}
+#endif /* USE_ITHREADS */
+
+int
+PerlProcFork(struct IPerlProc* piPerl)
+{
+ dTHXo;
+#ifdef USE_ITHREADS
+ DWORD id;
+ HANDLE handle;
+ CPerlHost *h = new CPerlHost();
+ PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
+ h->m_pHostperlMem,
+ h->m_pHostperlMemShared,
+ h->m_pHostperlMemParse,
+ h->m_pHostperlEnv,
+ h->m_pHostperlStdIO,
+ h->m_pHostperlLIO,
+ h->m_pHostperlDir,
+ h->m_pHostperlSock,
+ h->m_pHostperlProc
+ );
+# ifdef PERL_SYNC_FORK
+ id = win32_start_child((LPVOID)new_perl);
+ PERL_SET_INTERP(aTHXo);
+# else
+ handle = CreateThread(NULL, 0, win32_start_child,
+ (LPVOID)new_perl, 0, &id);
+ PERL_SET_INTERP(aTHXo);
+ if (!handle)
+ Perl_croak(aTHX_ "panic: pseudo fork() failed");
+ w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
+ w32_pseudo_child_pids[w32_num_pseudo_children] = id;
+ ++w32_num_pseudo_children;
+# endif
+ return -(int)id;
+#else
+ Perl_croak(aTHX_ "fork() not implemented!\n");
+ return -1;
+#endif /* USE_ITHREADS */
+}
+
+int
+PerlProcGetpid(struct IPerlProc* piPerl)
+{
+ return win32_getpid();
+}
+
+void*
+PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
+{
+ return win32_dynaload(filename);
+}
+
+void
+PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
+{
+ win32_str_os_error(sv, dwErr);
+}
+
+BOOL
+PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
+{
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+}
+
+int
+PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
+{
+ return do_spawn2(cmds, EXECF_SPAWN);
+}
+
+int
+PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
+{
+ return win32_spawnvp(mode, cmdname, argv);
+}
+
+int
+PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
+{
+ return do_aspawn(vreally, vmark, vsp);
+}
+
+struct IPerlProc perlProc =
+{
+ PerlProcAbort,
+ PerlProcCrypt,
+ PerlProcExit,
+ PerlProc_Exit,
+ PerlProcExecl,
+ PerlProcExecv,
+ PerlProcExecvp,
+ PerlProcGetuid,
+ PerlProcGeteuid,
+ PerlProcGetgid,
+ PerlProcGetegid,
+ PerlProcGetlogin,
+ PerlProcKill,
+ PerlProcKillpg,
+ PerlProcPauseProc,
+ PerlProcPopen,
+ PerlProcPclose,
+ PerlProcPipe,
+ PerlProcSetuid,
+ PerlProcSetgid,
+ PerlProcSleep,
+ PerlProcTimes,
+ PerlProcWait,
+ PerlProcWaitpid,
+ PerlProcSignal,
+ PerlProcFork,
+ PerlProcGetpid,
+ PerlProcDynaLoader,
+ PerlProcGetOSError,
+ PerlProcDoCmd,
+ PerlProcSpawn,
+ PerlProcSpawnvp,
+ PerlProcASpawn,
+};
+
+
+/*
+ * CPerlHost
+ */
+
+CPerlHost::CPerlHost(void)
+{
+ m_pvDir = new VDir();
+ m_pVMem = new VMem();
+ m_pVMemShared = new VMem();
+ m_pVMemParse = new VMem();
+
+ m_pvDir->Init(NULL, m_pVMem);
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+
+ m_pHostperlMem = &m_hostperlMem;
+ m_pHostperlMemShared = &m_hostperlMemShared;
+ m_pHostperlMemParse = &m_hostperlMemParse;
+ m_pHostperlEnv = &m_hostperlEnv;
+ m_pHostperlStdIO = &m_hostperlStdIO;
+ m_pHostperlLIO = &m_hostperlLIO;
+ m_pHostperlDir = &m_hostperlDir;
+ m_pHostperlSock = &m_hostperlSock;
+ m_pHostperlProc = &m_hostperlProc;
+}
+
+#define SETUPEXCHANGE(xptr, iptr, table) \
+ STMT_START { \
+ if (xptr) { \
+ iptr = *xptr; \
+ *xptr = &table; \
+ } \
+ else { \
+ iptr = &table; \
+ } \
+ } STMT_END
+
+CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc)
+{
+ m_pvDir = new VDir();
+ m_pVMem = new VMem();
+ m_pVMemShared = new VMem();
+ m_pVMemParse = new VMem();
+
+ m_pvDir->Init(NULL, m_pVMem);
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+
+ SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
+ SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
+ SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
+ SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
+ SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
+ SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
+ SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
+ SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
+ SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
+}
+#undef SETUPEXCHANGE
+
+CPerlHost::CPerlHost(CPerlHost& host)
+{
+ m_pVMem = new VMem();
+ m_pVMemShared = host.GetMemShared();
+ m_pVMemParse = host.GetMemParse();
+
+ /* duplicate directory info */
+ m_pvDir = new VDir();
+ m_pvDir->Init(host.GetDir(), m_pVMem);
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+ m_pHostperlMem = &host.m_hostperlMem;
+ m_pHostperlMemShared = &host.m_hostperlMemShared;
+ m_pHostperlMemParse = &host.m_hostperlMemParse;
+ m_pHostperlEnv = &host.m_hostperlEnv;
+ m_pHostperlStdIO = &host.m_hostperlStdIO;
+ m_pHostperlLIO = &host.m_hostperlLIO;
+ m_pHostperlDir = &host.m_hostperlDir;
+ m_pHostperlSock = &host.m_hostperlSock;
+ m_pHostperlProc = &host.m_hostperlProc;
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ /* duplicate environment info */
+ LPSTR lpPtr;
+ DWORD dwIndex = 0;
+ while(lpPtr = host.GetIndex(dwIndex))
+ Add(lpPtr);
+}
+
+CPerlHost::~CPerlHost(void)
+{
+// Reset();
+ delete m_pvDir;
+ m_pVMemParse->Release();
+ m_pVMemShared->Release();
+ m_pVMem->Release();
+}
+
+LPSTR
+CPerlHost::Find(LPCSTR lpStr)
+{
+ LPSTR lpPtr;
+ LPSTR* lppPtr = Lookup(lpStr);
+ if(lppPtr != NULL) {
+ for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
+ ;
+
+ if(*lpPtr == '=')
+ ++lpPtr;
+
+ return lpPtr;
+ }
+ return NULL;
+}
+
+int
+lookup(const void *arg1, const void *arg2)
+{ // Compare strings
+ char*ptr1, *ptr2;
+ char c1,c2;
+
+ ptr1 = *(char**)arg1;
+ ptr2 = *(char**)arg2;
+ for(;;) {
+ c1 = *ptr1++;
+ c2 = *ptr2++;
+ if(c1 == '\0' || c1 == '=') {
+ if(c2 == '\0' || c2 == '=')
+ break;
+
+ return -1; // string 1 < string 2
+ }
+ else if(c2 == '\0' || c2 == '=')
+ return 1; // string 1 > string 2
+ else if(c1 != c2) {
+ c1 = toupper(c1);
+ c2 = toupper(c2);
+ if(c1 != c2) {
+ if(c1 < c2)
+ return -1; // string 1 < string 2
+
+ return 1; // string 1 > string 2
+ }
+ }
+ }
+ return 0;
+}
+
+LPSTR*
+CPerlHost::Lookup(LPCSTR lpStr)
+{
+ return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
+}
+
+int
+compare(const void *arg1, const void *arg2)
+{ // Compare strings
+ char*ptr1, *ptr2;
+ char c1,c2;
+
+ ptr1 = *(char**)arg1;
+ ptr2 = *(char**)arg2;
+ for(;;) {
+ c1 = *ptr1++;
+ c2 = *ptr2++;
+ if(c1 == '\0' || c1 == '=') {
+ if(c1 == c2)
+ break;
+
+ return -1; // string 1 < string 2
+ }
+ else if(c2 == '\0' || c2 == '=')
+ return 1; // string 1 > string 2
+ else if(c1 != c2) {
+ c1 = toupper(c1);
+ c2 = toupper(c2);
+ if(c1 != c2) {
+ if(c1 < c2)
+ return -1; // string 1 < string 2
+
+ return 1; // string 1 > string 2
+ }
+ }
+ }
+ return 0;
+}
+
+void
+CPerlHost::Add(LPCSTR lpStr)
+{
+ dTHXo;
+ char szBuffer[1024];
+ LPSTR *lpPtr;
+ int index, length = strlen(lpStr)+1;
+
+ for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
+ szBuffer[index] = lpStr[index];
+
+ szBuffer[index] = '\0';
+
+ // replacing ?
+ lpPtr = Lookup(szBuffer);
+ if(lpPtr != NULL) {
+ Renew(*lpPtr, length, char);
+ strcpy(*lpPtr, lpStr);
+ }
+ else {
+ ++m_dwEnvCount;
+ Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
+ New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
+ if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
+ strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
+ qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+ }
+ else
+ --m_dwEnvCount;
+ }
+}
+
+DWORD
+CPerlHost::CalculateEnvironmentSpace(void)
+{
+ DWORD index;
+ DWORD dwSize = 0;
+ for(index = 0; index < m_dwEnvCount; ++index)
+ dwSize += strlen(m_lppEnvList[index]) + 1;
+
+ return dwSize;
+}
+
+void
+CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
+{
+ dTHXo;
+ Safefree(lpStr);
+}
+
+char*
+CPerlHost::GetChildDir(void)
+{
+ dTHXo;
+ int length;
+ char* ptr;
+ New(0, ptr, MAX_PATH+1, char);
+ if(ptr) {
+ m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
+ length = strlen(ptr)-1;
+ if(length > 0) {
+ if((ptr[length] == '\\') || (ptr[length] == '/'))
+ ptr[length] = 0;
+ }
+ }
+ return ptr;
+}
+
+void
+CPerlHost::FreeChildDir(char* pStr)
+{
+ dTHXo;
+ Safefree(pStr);
+}
+
+LPSTR
+CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
+{
+ dTHXo;
+ LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
+ DWORD dwSize, dwEnvIndex;
+ int nLength, compVal;
+
+ // get the process environment strings
+ lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
+
+ // step over current directory stuff
+ while(*lpTmp == '=')
+ lpTmp += strlen(lpTmp) + 1;
+
+ // save the start of the environment strings
+ lpEnvPtr = lpTmp;
+ for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
+ // calculate the size of the environment strings
+ dwSize += strlen(lpTmp) + 1;
+ }
+
+ // add the size of current directories
+ dwSize += vDir.CalculateEnvironmentSpace();
+
+ // add the additional space used by changes made to the environment
+ dwSize += CalculateEnvironmentSpace();
+
+ New(1, lpStr, dwSize, char);
+ lpPtr = lpStr;
+ if(lpStr != NULL) {
+ // build the local environment
+ lpStr = vDir.BuildEnvironmentSpace(lpStr);
+
+ dwEnvIndex = 0;
+ lpLocalEnv = GetIndex(dwEnvIndex);
+ while(*lpEnvPtr != '\0') {
+ if(lpLocalEnv == NULL) {
+ // all environment overrides have been added
+ // so copy string into place
+ strcpy(lpStr, lpEnvPtr);
+ nLength = strlen(lpEnvPtr) + 1;
+ lpStr += nLength;
+ lpEnvPtr += nLength;
+ }
+ else {
+ // determine which string to copy next
+ compVal = compare(&lpEnvPtr, &lpLocalEnv);
+ if(compVal < 0) {
+ strcpy(lpStr, lpEnvPtr);
+ nLength = strlen(lpEnvPtr) + 1;
+ lpStr += nLength;
+ lpEnvPtr += nLength;
+ }
+ else {
+ char *ptr = strchr(lpLocalEnv, '=');
+ if(ptr && ptr[1]) {
+ strcpy(lpStr, lpLocalEnv);
+ lpStr += strlen(lpLocalEnv) + 1;
+ }
+ lpLocalEnv = GetIndex(dwEnvIndex);
+ if(compVal == 0) {
+ // this string was replaced
+ lpEnvPtr += strlen(lpEnvPtr) + 1;
+ }
+ }
+ }
+ }
+
+ // add final NULL
+ *lpStr = '\0';
+ }
+
+ // release the process environment strings
+ FreeEnvironmentStrings(lpAllocPtr);
+
+ return lpPtr;
+}
+
+void
+CPerlHost::Reset(void)
+{
+ dTHXo;
+ if(m_lppEnvList != NULL) {
+ for(DWORD index = 0; index < m_dwEnvCount; ++index) {
+ Safefree(m_lppEnvList[index]);
+ m_lppEnvList[index] = NULL;
+ }
+ }
+ m_dwEnvCount = 0;
+}
+
+void
+CPerlHost::Clearenv(void)
+{
+ char ch;
+ LPSTR lpPtr, lpStr, lpEnvPtr;
+ if(m_lppEnvList != NULL) {
+ /* set every entry to an empty string */
+ for(DWORD index = 0; index < m_dwEnvCount; ++index) {
+ char* ptr = strchr(m_lppEnvList[index], '=');
+ if(ptr) {
+ *++ptr = 0;
+ }
+ }
+ }
+
+ /* get the process environment strings */
+ lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
+
+ /* step over current directory stuff */
+ while(*lpStr == '=')
+ lpStr += strlen(lpStr) + 1;
+
+ while(*lpStr) {
+ lpPtr = strchr(lpStr, '=');
+ if(lpPtr) {
+ ch = *++lpPtr;
+ *lpPtr = 0;
+ Add(lpStr);
+ *lpPtr = ch;
+ }
+ lpStr += strlen(lpStr) + 1;
+ }
+
+ FreeEnvironmentStrings(lpEnvPtr);
+}
+
+
+char*
+CPerlHost::Getenv(const char *varname)
+{
+ char* pEnv = Find(varname);
+ if(pEnv == NULL) {
+ pEnv = win32_getenv(varname);
+ }
+ else {
+ if(!*pEnv)
+ pEnv = 0;
+ }
+
+ return pEnv;
+}
+
+int
+CPerlHost::Putenv(const char *envstring)
+{
+ Add(envstring);
+ return 0;
+}
+
+int
+CPerlHost::Chdir(const char *dirname)
+{
+ dTHXo;
+ int ret;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
+ ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
+ }
+ else
+ ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
+ if(ret < 0) {
+ errno = ENOENT;
+ }
+ return ret;
+}
+
+#endif /* ___PerlHost_H___ */
#ifdef PERL_IMPLICIT_SYS
#include "win32iop.h"
#include <fcntl.h>
-#endif
-
-
-/* Register any extra external extensions */
-char *staticlinkmodules[] = {
- "DynaLoader",
- NULL,
-};
-
-EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
-
-static void
-xs_init(pTHXo)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-
-#ifdef PERL_IMPLICIT_SYS
-/* IPerlMem */
-void*
-PerlMemMalloc(struct IPerlMem *I, size_t size)
-{
- return win32_malloc(size);
-}
-void*
-PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size)
-{
- return win32_realloc(ptr, size);
-}
-void
-PerlMemFree(struct IPerlMem *I, void* ptr)
-{
- win32_free(ptr);
-}
-
-struct IPerlMem perlMem =
-{
- PerlMemMalloc,
- PerlMemRealloc,
- PerlMemFree,
-};
-
-
-/* IPerlEnv */
-extern char * g_win32_get_privlib(char *pl);
-extern char * g_win32_get_sitelib(char *pl);
-
-
-char*
-PerlEnvGetenv(struct IPerlEnv *I, const char *varname)
-{
- return win32_getenv(varname);
-};
-int
-PerlEnvPutenv(struct IPerlEnv *I, const char *envstring)
-{
- return win32_putenv(envstring);
-};
-
-char*
-PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len)
-{
- char *e = win32_getenv(varname);
- if (e)
- *len = strlen(e);
- return e;
-}
-
-int
-PerlEnvUname(struct IPerlEnv *I, struct utsname *name)
-{
- return win32_uname(name);
-}
-
-void
-PerlEnvClearenv(struct IPerlEnv *I)
-{
- dTHXo;
- char *envv = GetEnvironmentStrings();
- char *cur = envv;
- STRLEN len;
- while (*cur) {
- char *end = strchr(cur,'=');
- if (end && end != cur) {
- *end = '\0';
- my_setenv(cur,Nullch);
- *end = '=';
- cur = end + strlen(end+1)+2;
- }
- else if ((len = strlen(cur)))
- cur += len+1;
- }
- FreeEnvironmentStrings(envv);
-}
-
-void*
-PerlEnvGetChildEnv(struct IPerlEnv *I)
-{
- return NULL;
-}
-
-void
-PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env)
-{
-}
-
-char*
-PerlEnvGetChildDir(struct IPerlEnv *I)
-{
- return NULL;
-}
-
-void
-PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir)
-{
-}
-
-unsigned long
-PerlEnvOsId(struct IPerlEnv *I)
-{
- return win32_os_id();
-}
-
-char*
-PerlEnvLibPath(struct IPerlEnv *I, char *pl)
-{
- return g_win32_get_privlib(pl);
-}
-
-char*
-PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl)
-{
- return g_win32_get_sitelib(pl);
-}
-
-struct IPerlEnv perlEnv =
-{
- PerlEnvGetenv,
- PerlEnvPutenv,
- PerlEnvGetenv_len,
- PerlEnvUname,
- PerlEnvClearenv,
- PerlEnvGetChildEnv,
- PerlEnvFreeChildEnv,
- PerlEnvGetChildDir,
- PerlEnvFreeChildDir,
- PerlEnvOsId,
- PerlEnvLibPath,
- PerlEnvSiteLibPath,
-};
-
-
-/* PerlStdIO */
-PerlIO*
-PerlStdIOStdin(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stdin();
-}
-
-PerlIO*
-PerlStdIOStdout(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stdout();
-}
-
-PerlIO*
-PerlStdIOStderr(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stderr();
-}
-
-PerlIO*
-PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode)
-{
- return (PerlIO*)win32_fopen(path, mode);
-}
-
-int
-PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fclose(((FILE*)pf));
-}
-
-int
-PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_feof((FILE*)pf);
-}
-
-int
-PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_ferror((FILE*)pf);
-}
-
-void
-PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_clearerr((FILE*)pf);
-}
-
-int
-PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_getc((FILE*)pf);
-}
-
-char*
-PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef FILE_base
- FILE *f = (FILE*)pf;
- return FILE_base(f);
-#else
- return Nullch;
-#endif
-}
-
-int
-PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef FILE_bufsiz
- FILE *f = (FILE*)pf;
- return FILE_bufsiz(f);
-#else
- return (-1);
-#endif
-}
-
-int
-PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = (FILE*)pf;
- return FILE_cnt(f);
-#else
- return (-1);
-#endif
-}
-
-char*
-PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = (FILE*)pf;
- return FILE_ptr(f);
-#else
- return Nullch;
-#endif
-}
-
-char*
-PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n)
-{
- return win32_fgets(s, n, (FILE*)pf);
-}
-
-int
-PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c)
-{
- return win32_fputc(c, (FILE*)pf);
-}
-
-int
-PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s)
-{
- return win32_fputs(s, (FILE*)pf);
-}
-
-int
-PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fflush((FILE*)pf);
-}
-
-int
-PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c)
-{
- return win32_ungetc(c, (FILE*)pf);
-}
-
-int
-PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fileno((FILE*)pf);
-}
-
-PerlIO*
-PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode)
-{
- return (PerlIO*)win32_fdopen(fd, mode);
-}
-
-PerlIO*
-PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf)
-{
- return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
-}
-
-SSize_t
-PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size)
-{
- return win32_fread(buffer, 1, size, (FILE*)pf);
-}
-
-SSize_t
-PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size)
-{
- return win32_fwrite(buffer, 1, size, (FILE*)pf);
-}
-
-void
-PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer)
-{
- win32_setbuf((FILE*)pf, buffer);
-}
-
-int
-PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size)
-{
- return win32_setvbuf((FILE*)pf, buffer, type, size);
-}
-
-void
-PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n)
-{
-#ifdef STDIO_CNT_LVALUE
- FILE *f = (FILE*)pf;
- FILE_cnt(f) = n;
-#endif
-}
-
-void
-PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n)
-{
-#ifdef STDIO_PTR_LVALUE
- FILE *f = (FILE*)pf;
- FILE_ptr(f) = ptr;
- FILE_cnt(f) = n;
-#endif
-}
-
-void
-PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
-}
-
-int
-PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...)
-{
- va_list(arglist);
- va_start(arglist, format);
- return win32_vfprintf((FILE*)pf, format, arglist);
-}
-
-int
-PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist)
-{
- return win32_vfprintf((FILE*)pf, format, arglist);
-}
-
-long
-PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_ftell((FILE*)pf);
-}
-
-int
-PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin)
-{
- return win32_fseek((FILE*)pf, offset, origin);
-}
-
-void
-PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_rewind((FILE*)pf);
-}
-
-PerlIO*
-PerlStdIOTmpfile(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_tmpfile();
-}
-
-int
-PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p)
-{
- return win32_fgetpos((FILE*)pf, p);
-}
-
-int
-PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p)
-{
- return win32_fsetpos((FILE*)pf, p);
-}
-void
-PerlStdIOInit(struct IPerlStdIO *I)
-{
-}
-
-void
-PerlStdIOInitOSExtras(struct IPerlStdIO *I)
-{
- Perl_init_os_extras();
-}
-
-int
-PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags)
-{
- return win32_open_osfhandle(osfhandle, flags);
-}
-
-int
-PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum)
-{
- return win32_get_osfhandle(filenum);
-}
-
-
-struct IPerlStdIO perlStdIO =
-{
- PerlStdIOStdin,
- PerlStdIOStdout,
- PerlStdIOStderr,
- PerlStdIOOpen,
- PerlStdIOClose,
- PerlStdIOEof,
- PerlStdIOError,
- PerlStdIOClearerr,
- PerlStdIOGetc,
- PerlStdIOGetBase,
- PerlStdIOGetBufsiz,
- PerlStdIOGetCnt,
- PerlStdIOGetPtr,
- PerlStdIOGets,
- PerlStdIOPutc,
- PerlStdIOPuts,
- PerlStdIOFlush,
- PerlStdIOUngetc,
- PerlStdIOFileno,
- PerlStdIOFdopen,
- PerlStdIOReopen,
- PerlStdIORead,
- PerlStdIOWrite,
- PerlStdIOSetBuf,
- PerlStdIOSetVBuf,
- PerlStdIOSetCnt,
- PerlStdIOSetPtrCnt,
- PerlStdIOSetlinebuf,
- PerlStdIOPrintf,
- PerlStdIOVprintf,
- PerlStdIOTell,
- PerlStdIOSeek,
- PerlStdIORewind,
- PerlStdIOTmpfile,
- PerlStdIOGetpos,
- PerlStdIOSetpos,
- PerlStdIOInit,
- PerlStdIOInitOSExtras,
-};
-
-
-/* IPerlLIO */
-int
-PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode)
-{
- return access(path, mode);
-}
-
-int
-PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode)
-{
- return chmod(filename, pmode);
-}
-
-int
-PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group)
-{
- return chown(filename, owner, group);
-}
-
-int
-PerlLIOChsize(struct IPerlLIO *I, int handle, long size)
-{
- return chsize(handle, size);
-}
-
-int
-PerlLIOClose(struct IPerlLIO *I, int handle)
-{
- return win32_close(handle);
-}
-
-int
-PerlLIODup(struct IPerlLIO *I, int handle)
-{
- return win32_dup(handle);
-}
-
-int
-PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2)
-{
- return win32_dup2(handle1, handle2);
-}
-
-int
-PerlLIOFlock(struct IPerlLIO *I, int fd, int oper)
-{
- return win32_flock(fd, oper);
-}
-
-int
-PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer)
-{
- return fstat(handle, buffer);
-}
-
-int
-PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data)
-{
- return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
-}
-
-int
-PerlLIOIsatty(struct IPerlLIO *I, int fd)
-{
- return isatty(fd);
-}
-
-long
-PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
-{
- return win32_lseek(handle, offset, origin);
-}
-
-int
-PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
-{
- return win32_stat(path, buffer);
-}
-
-char*
-PerlLIOMktemp(struct IPerlLIO *I, char *Template)
-{
- return mktemp(Template);
-}
-
-int
-PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag)
-{
- return win32_open(filename, oflag);
-}
-
-int
-PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode)
-{
- int ret;
- if(stricmp(filename, "/dev/null") == 0)
- ret = open("NUL", oflag, pmode);
- else
- ret = open(filename, oflag, pmode);
-
- return ret;
-}
-
-int
-PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count)
-{
- return win32_read(handle, buffer, count);
-}
-
-int
-PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname)
-{
- return win32_rename(OldFileName, newname);
-}
-
-int
-PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode)
-{
- return win32_setmode(handle, mode);
-}
-
-int
-PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer)
-{
- return win32_stat(path, buffer);
-}
-
-char*
-PerlLIOTmpnam(struct IPerlLIO *I, char *string)
-{
- return tmpnam(string);
-}
-
-int
-PerlLIOUmask(struct IPerlLIO *I, int pmode)
-{
- return umask(pmode);
-}
-
-int
-PerlLIOUnlink(struct IPerlLIO *I, const char *filename)
-{
- chmod(filename, S_IREAD | S_IWRITE);
- return unlink(filename);
-}
-
-int
-PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times)
-{
- return win32_utime(filename, times);
-}
-
-int
-PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count)
-{
- return win32_write(handle, buffer, count);
-}
-
-struct IPerlLIO perlLIO =
-{
- PerlLIOAccess,
- PerlLIOChmod,
- PerlLIOChown,
- PerlLIOChsize,
- PerlLIOClose,
- PerlLIODup,
- PerlLIODup2,
- PerlLIOFlock,
- PerlLIOFileStat,
- PerlLIOIOCtl,
- PerlLIOIsatty,
- PerlLIOLseek,
- PerlLIOLstat,
- PerlLIOMktemp,
- PerlLIOOpen,
- PerlLIOOpen3,
- PerlLIORead,
- PerlLIORename,
- PerlLIOSetmode,
- PerlLIONameStat,
- PerlLIOTmpnam,
- PerlLIOUmask,
- PerlLIOUnlink,
- PerlLIOUtime,
- PerlLIOWrite,
-};
-
-/* IPerlDIR */
-int
-PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode)
-{
- return win32_mkdir(dirname, mode);
-}
-
-int
-PerlDirChdir(struct IPerlDir *I, const char *dirname)
-{
- return win32_chdir(dirname);
-}
-
-int
-PerlDirRmdir(struct IPerlDir *I, const char *dirname)
-{
- return win32_rmdir(dirname);
-}
-
-int
-PerlDirClose(struct IPerlDir *I, DIR *dirp)
-{
- return win32_closedir(dirp);
-}
-
-DIR*
-PerlDirOpen(struct IPerlDir *I, char *filename)
-{
- return win32_opendir(filename);
-}
-
-struct direct *
-PerlDirRead(struct IPerlDir *I, DIR *dirp)
-{
- return win32_readdir(dirp);
-}
-
-void
-PerlDirRewind(struct IPerlDir *I, DIR *dirp)
-{
- win32_rewinddir(dirp);
-}
-
-void
-PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc)
-{
- win32_seekdir(dirp, loc);
-}
-
-long
-PerlDirTell(struct IPerlDir *I, DIR *dirp)
-{
- return win32_telldir(dirp);
-}
-
-struct IPerlDir perlDir =
-{
- PerlDirMakedir,
- PerlDirChdir,
- PerlDirRmdir,
- PerlDirClose,
- PerlDirOpen,
- PerlDirRead,
- PerlDirRewind,
- PerlDirSeek,
- PerlDirTell,
-};
-
-
-/* IPerlSock */
-u_long
-PerlSockHtonl(struct IPerlSock *I, u_long hostlong)
-{
- return win32_htonl(hostlong);
-}
-
-u_short
-PerlSockHtons(struct IPerlSock *I, u_short hostshort)
-{
- return win32_htons(hostshort);
-}
-
-u_long
-PerlSockNtohl(struct IPerlSock *I, u_long netlong)
-{
- return win32_ntohl(netlong);
-}
-
-u_short
-PerlSockNtohs(struct IPerlSock *I, u_short netshort)
-{
- return win32_ntohs(netshort);
-}
-
-SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen)
-{
- return win32_accept(s, addr, addrlen);
-}
-
-int
-PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
-{
- return win32_bind(s, name, namelen);
-}
-
-int
-PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
-{
- return win32_connect(s, name, namelen);
-}
-
-void
-PerlSockEndhostent(struct IPerlSock *I)
-{
- win32_endhostent();
-}
-
-void
-PerlSockEndnetent(struct IPerlSock *I)
-{
- win32_endnetent();
-}
-
-void
-PerlSockEndprotoent(struct IPerlSock *I)
-{
- win32_endprotoent();
-}
-
-void
-PerlSockEndservent(struct IPerlSock *I)
-{
- win32_endservent();
-}
-
-struct hostent*
-PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type)
-{
- return win32_gethostbyaddr(addr, len, type);
-}
-
-struct hostent*
-PerlSockGethostbyname(struct IPerlSock *I, const char* name)
-{
- return win32_gethostbyname(name);
-}
-
-struct hostent*
-PerlSockGethostent(struct IPerlSock *I)
-{
- dTHXo;
- Perl_croak(aTHX_ "gethostent not implemented!\n");
- return NULL;
-}
-
-int
-PerlSockGethostname(struct IPerlSock *I, char* name, int namelen)
-{
- return win32_gethostname(name, namelen);
-}
-
-struct netent *
-PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type)
-{
- return win32_getnetbyaddr(net, type);
-}
-
-struct netent *
-PerlSockGetnetbyname(struct IPerlSock *I, const char *name)
-{
- return win32_getnetbyname((char*)name);
-}
-
-struct netent *
-PerlSockGetnetent(struct IPerlSock *I)
-{
- return win32_getnetent();
-}
-
-int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
-{
- return win32_getpeername(s, name, namelen);
-}
-
-struct protoent*
-PerlSockGetprotobyname(struct IPerlSock *I, const char* name)
-{
- return win32_getprotobyname(name);
-}
-
-struct protoent*
-PerlSockGetprotobynumber(struct IPerlSock *I, int number)
-{
- return win32_getprotobynumber(number);
-}
-
-struct protoent*
-PerlSockGetprotoent(struct IPerlSock *I)
-{
- return win32_getprotoent();
-}
-
-struct servent*
-PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto)
-{
- return win32_getservbyname(name, proto);
-}
-
-struct servent*
-PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto)
-{
- return win32_getservbyport(port, proto);
-}
-
-struct servent*
-PerlSockGetservent(struct IPerlSock *I)
-{
- return win32_getservent();
-}
-
-int
-PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
-{
- return win32_getsockname(s, name, namelen);
-}
-
-int
-PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen)
-{
- return win32_getsockopt(s, level, optname, optval, optlen);
-}
-
-unsigned long
-PerlSockInetAddr(struct IPerlSock *I, const char* cp)
-{
- return win32_inet_addr(cp);
-}
-
-char*
-PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in)
-{
- return win32_inet_ntoa(in);
-}
-
-int
-PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog)
-{
- return win32_listen(s, backlog);
-}
-
-int
-PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags)
-{
- return win32_recv(s, buffer, len, flags);
-}
-
-int
-PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
-{
- return win32_recvfrom(s, buffer, len, flags, from, fromlen);
-}
-
-int
-PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
-{
- return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
-}
-
-int
-PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags)
-{
- return win32_send(s, buffer, len, flags);
-}
-
-int
-PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
-{
- return win32_sendto(s, buffer, len, flags, to, tolen);
-}
-
-void
-PerlSockSethostent(struct IPerlSock *I, int stayopen)
-{
- win32_sethostent(stayopen);
-}
-
-void
-PerlSockSetnetent(struct IPerlSock *I, int stayopen)
-{
- win32_setnetent(stayopen);
-}
-
-void
-PerlSockSetprotoent(struct IPerlSock *I, int stayopen)
-{
- win32_setprotoent(stayopen);
-}
-
-void
-PerlSockSetservent(struct IPerlSock *I, int stayopen)
-{
- win32_setservent(stayopen);
-}
-
-int
-PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen)
-{
- return win32_setsockopt(s, level, optname, optval, optlen);
-}
-
-int
-PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how)
-{
- return win32_shutdown(s, how);
-}
-
-SOCKET
-PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol)
-{
- return win32_socket(af, type, protocol);
-}
-
-int
-PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds)
-{
- dTHXo;
- Perl_croak(aTHX_ "socketpair not implemented!\n");
- return 0;
-}
-
-int
-PerlSockClosesocket(struct IPerlSock *I, SOCKET s)
-{
- return win32_closesocket(s);
-}
+#endif /* PERL_IMPLICIT_SYS */
-int
-PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp)
-{
- return win32_ioctlsocket(s, cmd, argp);
-}
-struct IPerlSock perlSock =
-{
- PerlSockHtonl,
- PerlSockHtons,
- PerlSockNtohl,
- PerlSockNtohs,
- PerlSockAccept,
- PerlSockBind,
- PerlSockConnect,
- PerlSockEndhostent,
- PerlSockEndnetent,
- PerlSockEndprotoent,
- PerlSockEndservent,
- PerlSockGethostname,
- PerlSockGetpeername,
- PerlSockGethostbyaddr,
- PerlSockGethostbyname,
- PerlSockGethostent,
- PerlSockGetnetbyaddr,
- PerlSockGetnetbyname,
- PerlSockGetnetent,
- PerlSockGetprotobyname,
- PerlSockGetprotobynumber,
- PerlSockGetprotoent,
- PerlSockGetservbyname,
- PerlSockGetservbyport,
- PerlSockGetservent,
- PerlSockGetsockname,
- PerlSockGetsockopt,
- PerlSockInetAddr,
- PerlSockInetNtoa,
- PerlSockListen,
- PerlSockRecv,
- PerlSockRecvfrom,
- PerlSockSelect,
- PerlSockSend,
- PerlSockSendto,
- PerlSockSethostent,
- PerlSockSetnetent,
- PerlSockSetprotoent,
- PerlSockSetservent,
- PerlSockSetsockopt,
- PerlSockShutdown,
- PerlSockSocket,
- PerlSockSocketpair,
- PerlSockClosesocket,
+/* Register any extra external extensions */
+char *staticlinkmodules[] = {
+ "DynaLoader",
+ NULL,
};
+EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
-/* IPerlProc */
-
-#define EXECF_EXEC 1
-#define EXECF_SPAWN 2
-
-extern char * g_getlogin(void);
-extern int do_spawn2(char *cmd, int exectype);
-#ifdef PERL_OBJECT
-extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
-#define do_aspawn g_do_aspawn
-#endif
-EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
- struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
- struct IPerlLIO* pLIO, struct IPerlDir* pDir,
- struct IPerlSock* pSock, struct IPerlProc* pProc);
-
-void
-PerlProcAbort(struct IPerlProc *I)
-{
- win32_abort();
-}
-
-char *
-PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt)
-{
- return win32_crypt(clear, salt);
-}
-
-void
-PerlProcExit(struct IPerlProc *I, int status)
-{
- exit(status);
-}
-
-void
-PerlProc_Exit(struct IPerlProc *I, int status)
-{
- _exit(status);
-}
-
-int
-PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
-{
- return execl(cmdname, arg0, arg1, arg2, arg3);
-}
-
-int
-PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv)
-{
- return win32_execvp(cmdname, argv);
-}
-
-int
-PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv)
-{
- return win32_execvp(cmdname, argv);
-}
-
-uid_t
-PerlProcGetuid(struct IPerlProc *I)
-{
- return getuid();
-}
-
-uid_t
-PerlProcGeteuid(struct IPerlProc *I)
-{
- return geteuid();
-}
-
-gid_t
-PerlProcGetgid(struct IPerlProc *I)
-{
- return getgid();
-}
-
-gid_t
-PerlProcGetegid(struct IPerlProc *I)
-{
- return getegid();
-}
-
-char *
-PerlProcGetlogin(struct IPerlProc *I)
-{
- return g_getlogin();
-}
-
-int
-PerlProcKill(struct IPerlProc *I, int pid, int sig)
-{
- return win32_kill(pid, sig);
-}
-
-int
-PerlProcKillpg(struct IPerlProc *I, int pid, int sig)
-{
- dTHXo;
- Perl_croak(aTHX_ "killpg not implemented!\n");
- return 0;
-}
-
-int
-PerlProcPauseProc(struct IPerlProc *I)
-{
- return win32_sleep((32767L << 16) + 32767);
-}
-
-PerlIO*
-PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode)
-{
- PERL_FLUSHALL_FOR_CHILD;
- return (PerlIO*)win32_popen(command, mode);
-}
-
-int
-PerlProcPclose(struct IPerlProc *I, PerlIO *stream)
-{
- return win32_pclose((FILE*)stream);
-}
-
-int
-PerlProcPipe(struct IPerlProc *I, int *phandles)
-{
- return win32_pipe(phandles, 512, O_BINARY);
-}
-
-int
-PerlProcSetuid(struct IPerlProc *I, uid_t u)
-{
- return setuid(u);
-}
-
-int
-PerlProcSetgid(struct IPerlProc *I, gid_t g)
-{
- return setgid(g);
-}
-
-int
-PerlProcSleep(struct IPerlProc *I, unsigned int s)
-{
- return win32_sleep(s);
-}
-
-int
-PerlProcTimes(struct IPerlProc *I, struct tms *timebuf)
-{
- return win32_times(timebuf);
-}
-
-int
-PerlProcWait(struct IPerlProc *I, int *status)
-{
- return win32_wait(status);
-}
-
-int
-PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags)
-{
- return win32_waitpid(pid, status, flags);
-}
-
-Sighandler_t
-PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode)
-{
- return 0;
-}
-
-void*
-PerlProcDynaLoader(struct IPerlProc *I, const char* filename)
-{
- return win32_dynaload(filename);
-}
-
-void
-PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr)
-{
- win32_str_os_error(sv, dwErr);
-}
-
-BOOL
-PerlProcDoCmd(struct IPerlProc *I, char *cmd)
-{
- do_spawn2(cmd, EXECF_EXEC);
- return FALSE;
-}
-
-int
-PerlProcSpawn(struct IPerlProc *I, char* cmds)
-{
- return do_spawn2(cmds, EXECF_SPAWN);
-}
-
-int
-PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv)
-{
- return win32_spawnvp(mode, cmdname, argv);
-}
-
-int
-PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp)
+static void
+xs_init(pTHXo)
{
- return do_aspawn(vreally, vmark, vsp);
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
-struct IPerlProc perlProc =
-{
- PerlProcAbort,
- PerlProcCrypt,
- PerlProcExit,
- PerlProc_Exit,
- PerlProcExecl,
- PerlProcExecv,
- PerlProcExecvp,
- PerlProcGetuid,
- PerlProcGeteuid,
- PerlProcGetgid,
- PerlProcGetegid,
- PerlProcGetlogin,
- PerlProcKill,
- PerlProcKillpg,
- PerlProcPauseProc,
- PerlProcPopen,
- PerlProcPclose,
- PerlProcPipe,
- PerlProcSetuid,
- PerlProcSetgid,
- PerlProcSleep,
- PerlProcTimes,
- PerlProcWait,
- PerlProcWaitpid,
- PerlProcSignal,
- PerlProcDynaLoader,
- PerlProcGetOSError,
- PerlProcDoCmd,
- PerlProcSpawn,
- PerlProcSpawnvp,
- PerlProcASpawn,
-};
-
-/*#include "perlhost.h" */
+#ifdef PERL_IMPLICIT_SYS
+#include "perlhost.h"
EXTERN_C void
perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
+ struct IPerlMemInfo* perlMemSharedInfo,
+ struct IPerlMemInfo* perlMemParseInfo,
struct IPerlEnvInfo* perlEnvInfo,
struct IPerlStdIOInfo* perlStdIOInfo,
struct IPerlLIOInfo* perlLIOInfo,
struct IPerlSockInfo* perlSockInfo,
struct IPerlProcInfo* perlProcInfo)
{
- if(perlMemInfo) {
+ if (perlMemInfo) {
Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
}
- if(perlEnvInfo) {
+ if (perlMemSharedInfo) {
+ Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*);
+ perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
+ }
+ if (perlMemParseInfo) {
+ Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*);
+ perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
+ }
+ if (perlEnvInfo) {
Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
}
- if(perlStdIOInfo) {
+ if (perlStdIOInfo) {
Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
}
- if(perlLIOInfo) {
+ if (perlLIOInfo) {
Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
}
- if(perlDirInfo) {
+ if (perlDirInfo) {
Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
}
- if(perlSockInfo) {
+ if (perlSockInfo) {
Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
}
- if(perlProcInfo) {
+ if (perlProcInfo) {
Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
}
#ifdef PERL_OBJECT
-EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
- struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
- struct IPerlLIO* pLIO, struct IPerlDir* pDir,
- struct IPerlSock* pSock, struct IPerlProc* pProc)
+EXTERN_C PerlInterpreter*
+perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc)
{
- CPerlObj* pPerl = NULL;
+ PerlInterpreter *my_perl = NULL;
try
{
- pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
+ CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv,
+ ppStdIO, ppLIO, ppDir, ppSock, ppProc);
+
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+ w32_internal_host = pHost;
+ }
+ }
}
catch(...)
{
win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
- }
- if(pPerl)
- {
- SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)pPerl;
+ my_perl = NULL;
}
- SetPerlInterpreter(NULL);
- return NULL;
+
+ return my_perl;
}
-#undef perl_alloc
-#undef perl_construct
-#undef perl_destruct
-#undef perl_free
-#undef perl_run
-#undef perl_parse
-EXTERN_C PerlInterpreter* perl_alloc(void)
+EXTERN_C PerlInterpreter*
+perl_alloc(void)
{
- CPerlObj* pPerl = NULL;
+ PerlInterpreter* my_perl = NULL;
try
{
- pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
- &perlDir, &perlSock, &perlProc);
+ CPerlHost* pHost = new CPerlHost();
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+ w32_internal_host = pHost;
+ }
+ }
}
catch(...)
{
win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
- }
- if(pPerl)
- {
- SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)pPerl;
+ my_perl = NULL;
}
- SetPerlInterpreter(NULL);
- return NULL;
+
+ return my_perl;
}
-EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_construct(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
try
{
- pPerl->perl_construct();
+ Perl_construct();
}
catch(...)
{
win32_fprintf(stderr, "%s\n",
"Error: Unable to construct data structures");
- pPerl->perl_free();
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
SetPerlInterpreter(NULL);
}
}
-EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_destruct(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ Perl_destruct();
+#else
try
{
- pPerl->perl_destruct();
+ Perl_destruct();
}
catch(...)
{
}
+#endif
}
-EXTERN_C void perl_free(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_free(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
+#else
try
{
- pPerl->perl_free();
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
}
catch(...)
{
}
+#endif
SetPerlInterpreter(NULL);
}
-EXTERN_C int perl_run(PerlInterpreter* sv_interp)
+EXTERN_C int
+perl_run(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ return Perl_run();
+#else
int retVal;
try
{
- retVal = pPerl->perl_run();
- }
-/*
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
+ retVal = Perl_run();
}
-*/
catch(...)
{
win32_fprintf(stderr, "Error: Runtime exception\n");
retVal = -1;
}
return retVal;
+#endif
}
-EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
+EXTERN_C int
+perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
{
int retVal;
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ retVal = Perl_parse(xsinit, argc, argv, env);
+#else
try
{
- retVal = pPerl->perl_parse(xsinit, argc, argv, env);
- }
-/*
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
+ retVal = Perl_parse(xsinit, argc, argv, env);
}
-*/
catch(...)
{
win32_fprintf(stderr, "Error: Parse exception\n");
retVal = -1;
}
+#endif
*win32_errno() = 0;
return retVal;
}
EXTERN_C PerlInterpreter*
perl_alloc(void)
{
- return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
- &perlDir, &perlSock, &perlProc);
+ PerlInterpreter *my_perl = NULL;
+ CPerlHost* pHost = new CPerlHost();
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ w32_internal_host = pHost;
+ }
+ }
+ return my_perl;
}
#endif /* PERL_OBJECT */
-
#endif /* PERL_IMPLICIT_SYS */
-extern HANDLE w32_perldll_handle;
+EXTERN_C HANDLE w32_perldll_handle;
+
static DWORD g_TlsAllocIndex;
EXTERN_C DllExport bool
RunPerl(int argc, char **argv, char **env)
{
int exitstatus;
- PerlInterpreter *my_perl;
+ PerlInterpreter *my_perl, *new_perl = NULL;
struct perl_thread *thr;
#ifndef __BORLANDC__
exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
if (!exitstatus) {
+#if defined(TOP_CLONE) && defined(USE_ITHREADS) /* XXXXXX testing */
+# ifdef PERL_OBJECT
+ CPerlHost *h = new CPerlHost();
+ new_perl = perl_clone_using(my_perl, 1,
+ h->m_pHostperlMem,
+ h->m_pHostperlMemShared,
+ h->m_pHostperlMemParse,
+ h->m_pHostperlEnv,
+ h->m_pHostperlStdIO,
+ h->m_pHostperlLIO,
+ h->m_pHostperlDir,
+ h->m_pHostperlSock,
+ h->m_pHostperlProc
+ );
+ CPerlObj *pPerl = (CPerlObj*)new_perl;
+# else
+ new_perl = perl_clone(my_perl, 1);
+# endif
+ exitstatus = perl_run( new_perl );
+ SetPerlInterpreter(my_perl);
+#else
exitstatus = perl_run( my_perl );
+#endif
}
perl_destruct( my_perl );
perl_free( my_perl );
+#ifdef USE_ITHREADS
+ if (new_perl) {
+ SetPerlInterpreter(new_perl);
+ perl_destruct(new_perl);
+ perl_free(new_perl);
+ }
+#endif
PERL_SYS_TERM();
}
return TRUE;
}
-
--- /dev/null
+/* vdir.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ */
+
+#ifndef ___VDir_H___
+#define ___VDir_H___
+
+const int driveCount = 30;
+
+class VDir
+{
+public:
+ VDir();
+ ~VDir() {};
+
+ void Init(VDir* pDir, VMem *pMem);
+ void SetDefaultA(char const *pDefault);
+ void SetDefaultW(WCHAR const *pDefault);
+ char* MapPathA(const char *pInName);
+ WCHAR* MapPathW(const WCHAR *pInName);
+ int SetCurrentDirectoryA(char *lpBuffer);
+ int SetCurrentDirectoryW(WCHAR *lpBuffer);
+ inline const char *GetDirA(int index)
+ {
+ return dirTableA[index];
+ };
+ inline const WCHAR *GetDirW(int index)
+ {
+ return dirTableW[index];
+ };
+ inline int GetDefault(void) { return nDefault; };
+
+ inline char* GetCurrentDirectoryA(int dwBufSize, char *lpBuffer)
+ {
+ char* ptr = dirTableA[nDefault];
+ while (dwBufSize--)
+ {
+ if ((*lpBuffer++ = *ptr++) == '\0')
+ break;
+ }
+ return lpBuffer;
+ };
+ inline WCHAR* GetCurrentDirectoryW(int dwBufSize, WCHAR *lpBuffer)
+ {
+ WCHAR* ptr = dirTableW[nDefault];
+ while (dwBufSize--)
+ {
+ if ((*lpBuffer++ = *ptr++) == '\0')
+ break;
+ }
+ return lpBuffer;
+ };
+
+
+ DWORD CalculateEnvironmentSpace(void);
+ LPSTR BuildEnvironmentSpace(LPSTR lpStr);
+
+protected:
+ int SetDirA(char const *pPath, int index);
+ void FromEnvA(char *pEnv, int index);
+ inline const char *GetDefaultDirA(void)
+ {
+ return dirTableA[nDefault];
+ };
+
+ inline void SetDefaultDirA(char const *pPath, int index)
+ {
+ SetDirA(pPath, index);
+ nDefault = index;
+ };
+ int SetDirW(WCHAR const *pPath, int index);
+ inline const WCHAR *GetDefaultDirW(void)
+ {
+ return dirTableW[nDefault];
+ };
+
+ inline void SetDefaultDirW(WCHAR const *pPath, int index)
+ {
+ SetDirW(pPath, index);
+ nDefault = index;
+ };
+
+ inline int DriveIndex(char chr)
+ {
+ return (chr | 0x20)-'a';
+ };
+
+ VMem *pMem;
+ int nDefault;
+ char *dirTableA[driveCount];
+ char szLocalBufferA[MAX_PATH+1];
+ WCHAR *dirTableW[driveCount];
+ WCHAR szLocalBufferW[MAX_PATH+1];
+};
+
+
+VDir::VDir()
+{
+ nDefault = 0;
+ memset(dirTableA, 0, sizeof(dirTableA));
+ memset(dirTableW, 0, sizeof(dirTableW));
+}
+
+void VDir::Init(VDir* pDir, VMem *p)
+{
+ int index;
+ DWORD driveBits;
+ char szBuffer[MAX_PATH*driveCount];
+
+ pMem = p;
+ if (pDir) {
+ for (index = 0; index < driveCount; ++index) {
+ SetDirW(pDir->GetDirW(index), index);
+ }
+ nDefault = pDir->GetDefault();
+ }
+ else {
+ driveBits = GetLogicalDrives();
+ if (GetLogicalDriveStrings(sizeof(szBuffer), szBuffer)) {
+ char* pEnv = GetEnvironmentStrings();
+ char* ptr = szBuffer;
+ for (index = 0; index < driveCount; ++index) {
+ if (driveBits & (1<<index)) {
+ ptr += SetDirA(ptr, index) + 1;
+ FromEnvA(pEnv, index);
+ }
+ }
+ FreeEnvironmentStrings(pEnv);
+ }
+ SetDefaultA(".");
+ }
+}
+
+int VDir::SetDirA(char const *pPath, int index)
+{
+ char chr, *ptr;
+ int length = 0;
+ WCHAR wBuffer[MAX_PATH+1];
+ if (index < driveCount && pPath != NULL) {
+ length = strlen(pPath);
+ pMem->Free(dirTableA[index]);
+ ptr = dirTableA[index] = (char*)pMem->Malloc(length+2);
+ if (ptr != NULL) {
+ strcpy(ptr, pPath);
+ ptr += length-1;
+ chr = *ptr++;
+ if (chr != '\\' && chr != '/') {
+ *ptr++ = '\\';
+ *ptr = '\0';
+ }
+ MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1,
+ wBuffer, (sizeof(wBuffer)/sizeof(WCHAR)));
+ length = wcslen(wBuffer);
+ pMem->Free(dirTableW[index]);
+ dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2);
+ if (dirTableW[index] != NULL) {
+ wcscpy(dirTableW[index], wBuffer);
+ }
+ }
+ }
+ return length;
+}
+
+void VDir::FromEnvA(char *pEnv, int index)
+{ /* gets the directory for index from the environment variable. */
+ while (*pEnv != '\0') {
+ if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index)) {
+ SetDirA(&pEnv[4], index);
+ break;
+ }
+ else
+ pEnv += strlen(pEnv)+1;
+ }
+}
+
+void VDir::SetDefaultA(char const *pDefault)
+{
+ char szBuffer[MAX_PATH+1];
+ char *pPtr;
+
+ if (GetFullPathNameA(pDefault, sizeof(szBuffer), szBuffer, &pPtr)) {
+ if (*pDefault != '.' && pPtr != NULL)
+ *pPtr = '\0';
+
+ SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
+ }
+}
+
+int VDir::SetDirW(WCHAR const *pPath, int index)
+{
+ WCHAR chr, *ptr;
+ char szBuffer[MAX_PATH+1];
+ int length = 0;
+ if (index < driveCount && pPath != NULL) {
+ length = wcslen(pPath);
+ pMem->Free(dirTableW[index]);
+ ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2);
+ if (ptr != NULL) {
+ wcscpy(ptr, pPath);
+ ptr += length-1;
+ chr = *ptr++;
+ if (chr != '\\' && chr != '/') {
+ *ptr++ = '\\';
+ *ptr = '\0';
+ }
+ WideCharToMultiByte(CP_ACP, 0, dirTableW[index], -1, szBuffer, sizeof(szBuffer), NULL, NULL);
+ length = strlen(szBuffer);
+ pMem->Free(dirTableA[index]);
+ dirTableA[index] = (char*)pMem->Malloc(length+1);
+ if (dirTableA[index] != NULL) {
+ strcpy(dirTableA[index], szBuffer);
+ }
+ }
+ }
+ return length;
+}
+
+void VDir::SetDefaultW(WCHAR const *pDefault)
+{
+ WCHAR szBuffer[MAX_PATH+1];
+ WCHAR *pPtr;
+
+ if (GetFullPathNameW(pDefault, (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr)) {
+ if (*pDefault != '.' && pPtr != NULL)
+ *pPtr = '\0';
+
+ SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0]));
+ }
+}
+
+inline BOOL IsPathSep(char ch)
+{
+ return (ch == '\\' || ch == '/');
+}
+
+inline void DoGetFullPathNameA(char* lpBuffer, DWORD dwSize, char* Dest)
+{
+ char *pPtr;
+
+ /*
+ * On WinNT GetFullPathName does not fail, (or at least always
+ * succeeds when the drive is valid) WinNT does set *Dest to Nullch
+ * On Win98 GetFullPathName will set last error if it fails, but
+ * does not touch *Dest
+ */
+ *Dest = '\0';
+ GetFullPathNameA(lpBuffer, dwSize, Dest, &pPtr);
+}
+
+char *VDir::MapPathA(const char *pInName)
+{ /*
+ * possiblities -- relative path or absolute path with or without drive letter
+ * OR UNC name
+ */
+ char szBuffer[(MAX_PATH+1)*2];
+ char szlBuf[MAX_PATH+1];
+
+ if (strlen(pInName) > MAX_PATH) {
+ strncpy(szlBuf, pInName, MAX_PATH);
+ if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {
+ /* absolute path - reduce length by 2 for drive specifier */
+ szlBuf[MAX_PATH-2] = '\0';
+ }
+ else
+ szlBuf[MAX_PATH] = '\0';
+ pInName = szlBuf;
+ }
+ /* strlen(pInName) is now <= MAX_PATH */
+
+ if (pInName[1] == ':') {
+ /* has drive letter */
+ if (IsPathSep(pInName[2])) {
+ /* absolute with drive letter */
+ strcpy(szLocalBufferA, pInName);
+ }
+ else {
+ /* relative path with drive letter */
+ strcpy(szBuffer, GetDirA(DriveIndex(*pInName)));
+ strcat(szBuffer, &pInName[2]);
+ if(strlen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
+ }
+ }
+ else {
+ /* no drive letter */
+ if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ /* UNC name */
+ strcpy(szLocalBufferA, pInName);
+ }
+ else {
+ strcpy(szBuffer, GetDefaultDirA());
+ if (IsPathSep(pInName[0])) {
+ /* absolute path */
+ szLocalBufferA[0] = szBuffer[0];
+ szLocalBufferA[1] = szBuffer[1];
+ strcpy(&szLocalBufferA[2], pInName);
+ }
+ else {
+ /* relative path */
+ strcat(szBuffer, pInName);
+ if (strlen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
+ }
+ }
+ }
+
+ return szLocalBufferA;
+}
+
+int VDir::SetCurrentDirectoryA(char *lpBuffer)
+{
+ HANDLE hHandle;
+ WIN32_FIND_DATA win32FD;
+ char szBuffer[MAX_PATH+1], *pPtr;
+ int nRet = -1;
+
+ GetFullPathNameA(MapPathA(lpBuffer), sizeof(szBuffer), szBuffer, &pPtr);
+
+ hHandle = FindFirstFile(szBuffer, &win32FD);
+ if (hHandle != INVALID_HANDLE_VALUE) {
+ FindClose(hHandle);
+ SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
+ nRet = 0;
+ }
+ return nRet;
+}
+
+int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer)
+{
+ HANDLE hHandle;
+ WIN32_FIND_DATAW win32FD;
+ WCHAR szBuffer[MAX_PATH+1], *pPtr;
+ int nRet = -1;
+
+ GetFullPathNameW(MapPathW(lpBuffer), (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr);
+
+ hHandle = FindFirstFileW(szBuffer, &win32FD);
+ if (hHandle != INVALID_HANDLE_VALUE) {
+ FindClose(hHandle);
+ SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0]));
+ nRet = 0;
+ }
+ return nRet;
+}
+
+DWORD VDir::CalculateEnvironmentSpace(void)
+{ /* the current directory environment strings are stored as '=d=d:\path' */
+ int index;
+ DWORD dwSize = 0;
+ for (index = 0; index < driveCount; ++index) {
+ if (dirTableA[index] != NULL) {
+ dwSize += strlen(dirTableA[index]) + 4; /* add 1 for trailing NULL and 3 for '=d=' */
+ }
+ }
+ return dwSize;
+}
+
+LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr)
+{ /* store the current directory environment strings as '=d=d:\path' */
+ int index;
+ LPSTR lpDirStr;
+ for (index = 0; index < driveCount; ++index) {
+ lpDirStr = dirTableA[index];
+ if (lpDirStr != NULL) {
+ lpStr[0] = '=';
+ lpStr[1] = lpDirStr[0];
+ lpStr[2] = '=';
+ strcpy(&lpStr[3], lpDirStr);
+ lpStr += strlen(lpDirStr) + 4; /* add 1 for trailing NULL and 3 for '=d=' */
+ }
+ }
+ return lpStr;
+}
+
+inline BOOL IsPathSep(WCHAR ch)
+{
+ return (ch == '\\' || ch == '/');
+}
+
+inline void DoGetFullPathNameW(WCHAR* lpBuffer, DWORD dwSize, WCHAR* Dest)
+{
+ WCHAR *pPtr;
+
+ /*
+ * On WinNT GetFullPathName does not fail, (or at least always
+ * succeeds when the drive is valid) WinNT does set *Dest to Nullch
+ * On Win98 GetFullPathName will set last error if it fails, but
+ * does not touch *Dest
+ */
+ *Dest = '\0';
+ GetFullPathNameW(lpBuffer, dwSize, Dest, &pPtr);
+}
+
+WCHAR* VDir::MapPathW(const WCHAR *pInName)
+{ /*
+ * possiblities -- relative path or absolute path with or without drive letter
+ * OR UNC name
+ */
+ WCHAR szBuffer[(MAX_PATH+1)*2];
+ WCHAR szlBuf[MAX_PATH+1];
+
+ if (wcslen(pInName) > MAX_PATH) {
+ wcsncpy(szlBuf, pInName, MAX_PATH);
+ if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {
+ /* absolute path - reduce length by 2 for drive specifier */
+ szlBuf[MAX_PATH-2] = '\0';
+ }
+ else
+ szlBuf[MAX_PATH] = '\0';
+ pInName = szlBuf;
+ }
+ /* strlen(pInName) is now <= MAX_PATH */
+
+ if (pInName[1] == ':') {
+ /* has drive letter */
+ if (IsPathSep(pInName[2])) {
+ /* absolute with drive letter */
+ wcscpy(szLocalBufferW, pInName);
+ }
+ else {
+ /* relative path with drive letter */
+ wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName)));
+ wcscat(szBuffer, &pInName[2]);
+ if(wcslen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
+ }
+ }
+ else {
+ /* no drive letter */
+ if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ /* UNC name */
+ wcscpy(szLocalBufferW, pInName);
+ }
+ else {
+ wcscpy(szBuffer, GetDefaultDirW());
+ if (IsPathSep(pInName[0])) {
+ /* absolute path */
+ szLocalBufferW[0] = szBuffer[0];
+ szLocalBufferW[1] = szBuffer[1];
+ wcscpy(&szLocalBufferW[2], pInName);
+ }
+ else {
+ /* relative path */
+ wcscat(szBuffer, pInName);
+ if (wcslen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
+ }
+ }
+ }
+ return szLocalBufferW;
+}
+
+
+#endif /* ___VDir_H___ */
--- /dev/null
+/* vmem.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ *
+ * Knuth's boundary tag algorithm Vol #1, Page 440.
+ *
+ * Each block in the heap has tag words before and after it,
+ * TAG
+ * block
+ * TAG
+ * The size is stored in these tags as a long word, and includes the 8 bytes
+ * of overhead that the boundary tags consume. Blocks are allocated on long
+ * word boundaries, so the size is always multiples of long words. When the
+ * block is allocated, bit 0, (the tag bit), of the size is set to 1. When
+ * a block is freed, it is merged with adjacent free blocks, and the tag bit
+ * is set to 0.
+ *
+ * A linked list is used to manage the free list. The first two long words of
+ * the block contain double links. These links are only valid when the block
+ * is freed, therefore space needs to be reserved for them. Thus, the minimum
+ * block size (not counting the tags) is 8 bytes.
+ *
+ * Since memory allocation may occur on a single threaded, explict locks are
+ * provided.
+ *
+ */
+
+#ifndef ___VMEM_H_INC___
+#define ___VMEM_H_INC___
+
+const long lAllocStart = 0x00010000; /* start at 64K */
+const long minBlockSize = sizeof(void*)*2;
+const long sizeofTag = sizeof(long);
+const long blockOverhead = sizeofTag*2;
+const long minAllocSize = minBlockSize+blockOverhead;
+
+typedef BYTE* PBLOCK; /* pointer to a memory block */
+
+/*
+ * Macros for accessing hidden fields in a memory block:
+ *
+ * SIZE size of this block (tag bit 0 is 1 if block is allocated)
+ * PSIZE size of previous physical block
+ */
+
+#define SIZE(block) (*(ULONG*)(((PBLOCK)(block))-sizeofTag))
+#define PSIZE(block) (*(ULONG*)(((PBLOCK)(block))-(sizeofTag*2)))
+inline void SetTags(PBLOCK block, long size)
+{
+ SIZE(block) = size;
+ PSIZE(block+(size&~1)) = size;
+}
+
+/*
+ * Free list pointers
+ * PREV pointer to previous block
+ * NEXT pointer to next block
+ */
+
+#define PREV(block) (*(PBLOCK*)(block))
+#define NEXT(block) (*(PBLOCK*)((block)+sizeof(PBLOCK)))
+inline void SetLink(PBLOCK block, PBLOCK prev, PBLOCK next)
+{
+ PREV(block) = prev;
+ NEXT(block) = next;
+}
+inline void Unlink(PBLOCK p)
+{
+ PBLOCK next = NEXT(p);
+ PBLOCK prev = PREV(p);
+ NEXT(prev) = next;
+ PREV(next) = prev;
+}
+inline void AddToFreeList(PBLOCK block, PBLOCK pInList)
+{
+ PBLOCK next = NEXT(pInList);
+ NEXT(pInList) = block;
+ SetLink(block, pInList, next);
+ PREV(next) = block;
+}
+
+
+/* Macro for rounding up to the next sizeof(long) */
+#define ROUND_UP(n) (((ULONG)(n)+sizeof(long)-1)&~(sizeof(long)-1))
+#define ROUND_UP64K(n) (((ULONG)(n)+0x10000-1)&~(0x10000-1))
+#define ROUND_DOWN(n) ((ULONG)(n)&~(sizeof(long)-1))
+
+/*
+ * HeapRec - a list of all non-contiguous heap areas
+ *
+ * Each record in this array contains information about a non-contiguous heap area.
+ */
+
+const int maxHeaps = 64;
+const long lAllocMax = 0x80000000; /* max size of allocation */
+
+typedef struct _HeapRec
+{
+ PBLOCK base; /* base of heap area */
+ ULONG len; /* size of heap area */
+} HeapRec;
+
+
+class VMem
+{
+public:
+ VMem();
+ ~VMem();
+ virtual void* Malloc(size_t size);
+ virtual void* Realloc(void* pMem, size_t size);
+ virtual void Free(void* pMem);
+ virtual void GetLock(void);
+ virtual void FreeLock(void);
+ virtual int IsLocked(void);
+ virtual long Release(void);
+ virtual long AddRef(void);
+
+ inline BOOL CreateOk(void)
+ {
+ return m_hHeap != NULL;
+ };
+
+ void ReInit(void);
+
+protected:
+ void Init(void);
+ int Getmem(size_t size);
+ int HeapAdd(void* ptr, size_t size);
+ void* Expand(void* block, size_t size);
+ void WalkHeap(void);
+
+ HANDLE m_hHeap; // memory heap for this script
+ char m_FreeDummy[minAllocSize]; // dummy free block
+ PBLOCK m_pFreeList; // pointer to first block on free list
+ PBLOCK m_pRover; // roving pointer into the free list
+ HeapRec m_heaps[maxHeaps]; // list of all non-contiguous heap areas
+ int m_nHeaps; // no. of heaps in m_heaps
+ long m_lAllocSize; // current alloc size
+ long m_lRefCount; // number of current users
+ CRITICAL_SECTION m_cs; // access lock
+};
+
+// #define _DEBUG_MEM
+#ifdef _DEBUG_MEM
+#define ASSERT(f) if(!(f)) DebugBreak();
+
+inline void MEMODS(char *str)
+{
+ OutputDebugString(str);
+ OutputDebugString("\n");
+}
+
+inline void MEMODSlx(char *str, long x)
+{
+ char szBuffer[512];
+ sprintf(szBuffer, "%s %lx\n", str, x);
+ OutputDebugString(szBuffer);
+}
+
+#define WALKHEAP() WalkHeap()
+#define WALKHEAPTRACE() m_pRover = NULL; WalkHeap()
+
+#else
+
+#define ASSERT(f)
+#define MEMODS(x)
+#define MEMODSlx(x, y)
+#define WALKHEAP()
+#define WALKHEAPTRACE()
+
+#endif
+
+
+VMem::VMem()
+{
+ m_lRefCount = 1;
+ BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE,
+ lAllocStart, /* initial size of heap */
+ 0))); /* no upper limit on size of heap */
+ ASSERT(bRet);
+
+ InitializeCriticalSection(&m_cs);
+
+ Init();
+}
+
+VMem::~VMem(void)
+{
+ ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL));
+ WALKHEAPTRACE();
+ DeleteCriticalSection(&m_cs);
+ BOOL bRet = HeapDestroy(m_hHeap);
+ ASSERT(bRet);
+}
+
+void VMem::ReInit(void)
+{
+ for(int index = 0; index < m_nHeaps; ++index)
+ HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base);
+
+ Init();
+}
+
+void VMem::Init(void)
+{ /*
+ * Initialize the free list by placing a dummy zero-length block on it.
+ * Set the number of non-contiguous heaps to zero.
+ */
+ m_pFreeList = m_pRover = (PBLOCK)(&m_FreeDummy[minBlockSize]);
+ PSIZE(m_pFreeList) = SIZE(m_pFreeList) = 0;
+ PREV(m_pFreeList) = NEXT(m_pFreeList) = m_pFreeList;
+
+ m_nHeaps = 0;
+ m_lAllocSize = lAllocStart;
+}
+
+void* VMem::Malloc(size_t size)
+{
+ WALKHEAP();
+
+ /*
+ * Adjust the real size of the block to be a multiple of sizeof(long), and add
+ * the overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize || size == 0)
+ return NULL;
+
+ /*
+ * Start searching the free list at the rover. If we arrive back at rover without
+ * finding anything, allocate some memory from the heap and try again.
+ */
+ PBLOCK ptr = m_pRover; /* start searching at rover */
+ int loops = 2; /* allow two times through the loop */
+ for(;;) {
+ size_t lsize = SIZE(ptr);
+ ASSERT((lsize&1)==0);
+ /* is block big enough? */
+ if(lsize >= realsize) {
+ /* if the remainder is too small, don't bother splitting the block. */
+ size_t rem = lsize - realsize;
+ if(rem < minAllocSize) {
+ if(m_pRover == ptr)
+ m_pRover = NEXT(ptr);
+
+ /* Unlink the block from the free list. */
+ Unlink(ptr);
+ }
+ else {
+ /*
+ * split the block
+ * The remainder is big enough to split off into a new block.
+ * Use the end of the block, resize the beginning of the block
+ * no need to change the free list.
+ */
+ SetTags(ptr, rem);
+ ptr += SIZE(ptr);
+ lsize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, lsize | 1);
+ return ((void *)ptr);
+ }
+
+ /*
+ * This block was unsuitable. If we've gone through this list once already without
+ * finding anything, allocate some new memory from the heap and try again.
+ */
+ ptr = NEXT(ptr);
+ if(ptr == m_pRover) {
+ if(!(loops-- && Getmem(realsize))) {
+ return NULL;
+ }
+ ptr = m_pRover;
+ }
+ }
+}
+
+void* VMem::Realloc(void* block, size_t size)
+{
+ WALKHEAP();
+
+ /* if size is zero, free the block. */
+ if(size == 0) {
+ Free(block);
+ return (NULL);
+ }
+
+ /* if block pointer is NULL, do a Malloc(). */
+ if(block == NULL)
+ return Malloc(size);
+
+ /*
+ * Grow or shrink the block in place.
+ * if the block grows then the next block will be used if free
+ */
+ if(Expand(block, size) != NULL)
+ return block;
+
+ /*
+ * adjust the real size of the block to be a multiple of sizeof(long), and add the
+ * overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize)
+ return NULL;
+
+ /*
+ * see if the previous block is free, and is it big enough to cover the new size
+ * if merged with the current block.
+ */
+ PBLOCK ptr = (PBLOCK)block;
+ size_t cursize = SIZE(ptr) & ~1;
+ size_t psize = PSIZE(ptr);
+ if((psize&1) == 0 && (psize + cursize) >= realsize) {
+ PBLOCK prev = ptr - psize;
+ if(m_pRover == prev)
+ m_pRover = NEXT(prev);
+
+ /* Unlink the next block from the free list. */
+ Unlink(prev);
+
+ /* Copy contents of old block to new location, make it the current block. */
+ memmove(prev, ptr, cursize);
+ cursize += psize; /* combine sizes */
+ ptr = prev;
+
+ size_t rem = cursize - realsize;
+ if(rem >= minAllocSize) {
+ /*
+ * The remainder is big enough to be a new block. Set boundary
+ * tags for the resized block and the new block.
+ */
+ prev = ptr + realsize;
+ /*
+ * add the new block to the free list.
+ * next block cannot be free
+ */
+ SetTags(prev, rem);
+ AddToFreeList(prev, m_pFreeList);
+ cursize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, cursize | 1);
+ return ((void *)ptr);
+ }
+
+ /* Allocate a new block, copy the old to the new, and free the old. */
+ if((ptr = (PBLOCK)Malloc(size)) != NULL) {
+ memmove(ptr, block, cursize-minBlockSize);
+ Free(block);
+ }
+ return ((void *)ptr);
+}
+
+void VMem::Free(void* p)
+{
+ WALKHEAP();
+
+ /* Ignore null pointer. */
+ if(p == NULL)
+ return;
+
+ PBLOCK ptr = (PBLOCK)p;
+
+ /* Check for attempt to free a block that's already free. */
+ size_t size = SIZE(ptr);
+ if((size&1) == 0) {
+ MEMODSlx("Attempt to free previously freed block", (long)p);
+ return;
+ }
+ size &= ~1; /* remove allocated tag */
+
+ /* if previous block is free, add this block to it. */
+ int linked = FALSE;
+ size_t psize = PSIZE(ptr);
+ if((psize&1) == 0) {
+ ptr -= psize; /* point to previous block */
+ size += psize; /* merge the sizes of the two blocks */
+ linked = TRUE; /* it's already on the free list */
+ }
+
+ /* if the next physical block is free, merge it with this block. */
+ PBLOCK next = ptr + size; /* point to next physical block */
+ size_t nsize = SIZE(next);
+ if((nsize&1) == 0) {
+ /* block is free move rover if needed */
+ if(m_pRover == next)
+ m_pRover = NEXT(next);
+
+ /* unlink the next block from the free list. */
+ Unlink(next);
+
+ /* merge the sizes of this block and the next block. */
+ size += nsize;
+ }
+
+ /* Set the boundary tags for the block; */
+ SetTags(ptr, size);
+
+ /* Link the block to the head of the free list. */
+ if(!linked) {
+ AddToFreeList(ptr, m_pFreeList);
+ }
+}
+
+void VMem::GetLock(void)
+{
+ EnterCriticalSection(&m_cs);
+}
+
+void VMem::FreeLock(void)
+{
+ LeaveCriticalSection(&m_cs);
+}
+
+int VMem::IsLocked(void)
+{
+ BOOL bAccessed = TryEnterCriticalSection(&m_cs);
+ if(bAccessed) {
+ LeaveCriticalSection(&m_cs);
+ }
+ return !bAccessed;
+}
+
+
+long VMem::Release(void)
+{
+ long lCount = InterlockedDecrement(&m_lRefCount);
+ if(!lCount)
+ delete this;
+ return lCount;
+}
+
+long VMem::AddRef(void)
+{
+ long lCount = InterlockedIncrement(&m_lRefCount);
+ return lCount;
+}
+
+
+int VMem::Getmem(size_t requestSize)
+{ /* returns -1 is successful 0 if not */
+ void *ptr;
+
+ /* Round up size to next multiple of 64K. */
+ size_t size = (size_t)ROUND_UP64K(requestSize);
+
+ /*
+ * if the size requested is smaller than our current allocation size
+ * adjust up
+ */
+ if(size < (unsigned long)m_lAllocSize)
+ size = m_lAllocSize;
+
+ /* Update the size to allocate on the next request */
+ if(m_lAllocSize != lAllocMax)
+ m_lAllocSize <<= 1;
+
+ if(m_nHeaps != 0) {
+ /* Expand the last allocated heap */
+ ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE,
+ m_heaps[m_nHeaps-1].base,
+ m_heaps[m_nHeaps-1].len + size);
+ if(ptr != 0) {
+ HeapAdd(((char*)ptr) + m_heaps[m_nHeaps-1].len, size);
+ return -1;
+ }
+ }
+
+ /*
+ * if we didn't expand a block to cover the requested size
+ * allocate a new Heap
+ * the size of this block must include the additional dummy tags at either end
+ * the above ROUND_UP64K may not have added any memory to include this.
+ */
+ if(size == requestSize)
+ size = (size_t)ROUND_UP64K(requestSize+(sizeofTag*2));
+
+ ptr = HeapAlloc(m_hHeap, HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE, size);
+ if(ptr == 0) {
+ MEMODSlx("HeapAlloc failed on size!!!", size);
+ return 0;
+ }
+
+ HeapAdd(ptr, size);
+ return -1;
+}
+
+int VMem::HeapAdd(void *p, size_t size)
+{ /* if the block can be succesfully added to the heap, returns 0; otherwise -1. */
+ int index;
+
+ /* Check size, then round size down to next long word boundary. */
+ if(size < minAllocSize)
+ return -1;
+
+ size = (size_t)ROUND_DOWN(size);
+ PBLOCK ptr = (PBLOCK)p;
+
+ /*
+ * Search for another heap area that's contiguous with the bottom of this new area.
+ * (It should be extremely unusual to find one that's contiguous with the top).
+ */
+ for(index = 0; index < m_nHeaps; ++index) {
+ if(ptr == m_heaps[index].base + (int)m_heaps[index].len) {
+ /*
+ * The new block is contiguous with a previously allocated heap area. Add its
+ * length to that of the previous heap. Merge it with the the dummy end-of-heap
+ * area marker of the previous heap.
+ */
+ m_heaps[index].len += size;
+ break;
+ }
+ }
+
+ if(index == m_nHeaps) {
+ /* The new block is not contiguous. Add it to the heap list. */
+ if(m_nHeaps == maxHeaps) {
+ return -1; /* too many non-contiguous heaps */
+ }
+ m_heaps[m_nHeaps].base = ptr;
+ m_heaps[m_nHeaps].len = size;
+ m_nHeaps++;
+
+ /*
+ * Reserve the first LONG in the block for the ending boundary tag of a dummy
+ * block at the start of the heap area.
+ */
+ size -= minBlockSize;
+ ptr += minBlockSize;
+ PSIZE(ptr) = 1; /* mark the dummy previous block as allocated */
+ }
+
+ /*
+ * Convert the heap to one large block. Set up its boundary tags, and those of
+ * marker block after it. The marker block before the heap will already have
+ * been set up if this heap is not contiguous with the end of another heap.
+ */
+ SetTags(ptr, size | 1);
+ PBLOCK next = ptr + size; /* point to dummy end block */
+ SIZE(next) = 1; /* mark the dummy end block as allocated */
+
+ /*
+ * Link the block to the start of the free list by calling free().
+ * This will merge the block with any adjacent free blocks.
+ */
+ Free(ptr);
+ return 0;
+}
+
+
+void* VMem::Expand(void* block, size_t size)
+{
+ /*
+ * Adjust the size of the block to be a multiple of sizeof(long), and add the
+ * overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize || size == 0)
+ return NULL;
+
+ PBLOCK ptr = (PBLOCK)block;
+
+ /* if the current size is the same as requested, do nothing. */
+ size_t cursize = SIZE(ptr) & ~1;
+ if(cursize == realsize) {
+ return block;
+ }
+
+ /* if the block is being shrunk, convert the remainder of the block into a new free block. */
+ if(realsize <= cursize) {
+ size_t nextsize = cursize - realsize; /* size of new remainder block */
+ if(nextsize >= minAllocSize) {
+ /*
+ * Split the block
+ * Set boundary tags for the resized block and the new block.
+ */
+ SetTags(ptr, realsize | 1);
+ ptr += realsize;
+
+ /*
+ * add the new block to the free list.
+ * call Free to merge this block with next block if free
+ */
+ SetTags(ptr, nextsize | 1);
+ Free(ptr);
+ }
+
+ return block;
+ }
+
+ PBLOCK next = ptr + cursize;
+ size_t nextsize = SIZE(next);
+
+ /* Check the next block for consistency.*/
+ if((nextsize&1) == 0 && (nextsize + cursize) >= realsize) {
+ /*
+ * The next block is free and big enough. Add the part that's needed
+ * to our block, and split the remainder off into a new block.
+ */
+ if(m_pRover == next)
+ m_pRover = NEXT(next);
+
+ /* Unlink the next block from the free list. */
+ Unlink(next);
+ cursize += nextsize; /* combine sizes */
+
+ size_t rem = cursize - realsize; /* size of remainder */
+ if(rem >= minAllocSize) {
+ /*
+ * The remainder is big enough to be a new block.
+ * Set boundary tags for the resized block and the new block.
+ */
+ next = ptr + realsize;
+ /*
+ * add the new block to the free list.
+ * next block cannot be free
+ */
+ SetTags(next, rem);
+ AddToFreeList(next, m_pFreeList);
+ cursize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, cursize | 1);
+ return ((void *)ptr);
+ }
+ return NULL;
+}
+
+#ifdef _DEBUG_MEM
+#define LOG_FILENAME "P:\\Apps\\Perl\\Result.txt"
+
+void MemoryUsageMessage(char *str, long x, long y, int c)
+{
+ static FILE* fp = NULL;
+ char szBuffer[512];
+ if(str) {
+ if(!fp)
+ fp = fopen(LOG_FILENAME, "w");
+ sprintf(szBuffer, str, x, y, c);
+ fputs(szBuffer, fp);
+ }
+ else {
+ fflush(fp);
+ fclose(fp);
+ }
+}
+
+void VMem::WalkHeap(void)
+{
+ if(!m_pRover) {
+ MemoryUsageMessage("VMem heaps used %d\n", m_nHeaps, 0, 0);
+ }
+
+ /* Walk all the heaps - verify structures */
+ for(int index = 0; index < m_nHeaps; ++index) {
+ PBLOCK ptr = m_heaps[index].base;
+ size_t size = m_heaps[index].len;
+ ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, p));
+
+ /* set over reserved header block */
+ size -= minBlockSize;
+ ptr += minBlockSize;
+ PBLOCK pLast = ptr + size;
+ ASSERT(PSIZE(ptr) == 1); /* dummy previous block is allocated */
+ ASSERT(SIZE(pLast) == 1); /* dummy next block is allocated */
+ while(ptr < pLast) {
+ ASSERT(ptr > m_heaps[index].base);
+ size_t cursize = SIZE(ptr) & ~1;
+ ASSERT((PSIZE(ptr+cursize) & ~1) == cursize);
+ if(!m_pRover) {
+ MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(p)&1) ? 'x' : ' ');
+ }
+ if(!(SIZE(ptr)&1)) {
+ /* this block is on the free list */
+ PBLOCK tmp = NEXT(ptr);
+ while(tmp != ptr) {
+ ASSERT((SIZE(tmp)&1)==0);
+ if(tmp == m_pFreeList)
+ break;
+ ASSERT(NEXT(tmp));
+ tmp = NEXT(tmp);
+ }
+ if(tmp == ptr) {
+ MemoryUsageMessage("Memory Block %08x: Size %08x free but not in free list\n", (long)ptr, cursize, 0);
+ }
+ }
+ ptr += cursize;
+ }
+ }
+ if(!m_pRover) {
+ MemoryUsageMessage(NULL, 0, 0, 0);
+ }
+}
+#endif
+
+#endif /* ___VMEM_H_INC___ */
#endif
#include <windows.h>
-#ifndef __MINGW32__
-#include <lmcons.h>
-#include <lmerr.h>
-/* ugliness to work around a buggy struct definition in lmwksta.h */
-#undef LPTSTR
-#define LPTSTR LPWSTR
-#include <lmwksta.h>
-#undef LPTSTR
-#define LPTSTR LPSTR
-#include <lmapibuf.h>
-#endif /* __MINGW32__ */
-
/* #include "config.h" */
#define PERLIO_NOT_STDIO 0
int _CRT_glob = 0;
#endif
-#ifdef __BORLANDC__
+#if defined(__MINGW32__)
+# define _stat stat
+#endif
+
+#if defined(__BORLANDC__)
# define _stat stat
# define _utimbuf utimbuf
#endif
#endif
static void get_shell(void);
-static long tokenize(char *str, char **dest, char ***destv);
+static long tokenize(const char *str, char **dest, char ***destv);
int do_spawn2(char *cmd, int exectype);
static BOOL has_shell_metachars(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static void remove_dead_process(long deceased);
static long find_pid(int pid);
static char * qualified_path(const char *cmd);
+#ifdef USE_ITHREADS
+static void remove_dead_pseudo_process(long child);
+static long find_pseudo_pid(int pid);
+#endif
+START_EXTERN_C
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
char w32_module_name[MAX_PATH+1];
+END_EXTERN_C
+
static DWORD w32_platform = (DWORD)-1;
-#ifdef USE_THREADS
-# ifdef USE_DECLSPEC_THREAD
-__declspec(thread) char strerror_buffer[512];
-__declspec(thread) char getlogin_buffer[128];
-__declspec(thread) char w32_perllib_root[MAX_PATH+1];
-# ifdef HAVE_DES_FCRYPT
-__declspec(thread) char crypt_buffer[30];
-# endif
-# else
-# define strerror_buffer (thr->i.Wstrerror_buffer)
-# define getlogin_buffer (thr->i.Wgetlogin_buffer)
-# define w32_perllib_root (thr->i.Ww32_perllib_root)
-# define crypt_buffer (thr->i.Wcrypt_buffer)
-# endif
-#else
-static char strerror_buffer[512];
-static char getlogin_buffer[128];
-static char w32_perllib_root[MAX_PATH+1];
-# ifdef HAVE_DES_FCRYPT
-static char crypt_buffer[30];
-# endif
-#endif
+#define ONE_K_BUFSIZE 1024
int
IsWin95(void)
Perl_my_popen(pTHX_ char *cmd, char *mode)
{
#ifdef FIXCMD
-#define fixcmd(x) { \
- char *pspace = strchr((x),' '); \
- if (pspace) { \
- char *p = (x); \
- while (p < pspace) { \
- if (*p == '/') \
- *p = '\\'; \
- p++; \
- } \
- } \
- }
+#define fixcmd(x) { \
+ char *pspace = strchr((x),' '); \
+ if (pspace) { \
+ char *p = (x); \
+ while (p < pspace) { \
+ if (*p == '/') \
+ *p = '\\'; \
+ p++; \
+ } \
+ } \
+ }
#else
#define fixcmd(x)
#endif
return (unsigned long)w32_platform;
}
+DllExport int
+win32_getpid(void)
+{
+#ifdef USE_ITHREADS
+ dTHXo;
+ if (w32_pseudo_id)
+ return -((int)w32_pseudo_id);
+#endif
+ return _getpid();
+}
+
/* Tokenize a string. Words are null-separated, and the list
* ends with a doubled null. Any character (except null and
* including backslash) may be escaped by preceding it with a
* Returns number of words in result buffer.
*/
static long
-tokenize(char *str, char **dest, char ***destv)
+tokenize(const char *str, char **dest, char ***destv)
{
char *retstart = Nullch;
char **retvstart = 0;
* interactive use (which is what most programs look in COMSPEC
* for).
*/
- char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
- char *usershell = getenv("PERL5SHELL");
+ const char* defaultshell = (IsWinNT()
+ ? "cmd.exe /x/c" : "command.com /c");
+ const char *usershell = getenv("PERL5SHELL");
w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
&w32_perlshell_tokens,
&w32_perlshell_vec);
/* do the FindFirstFile call */
if (USING_WIDE()) {
A2WHELPER(scanname, wbuffer, sizeof(wbuffer));
- fh = FindFirstFileW(wbuffer, &wFindData);
+ fh = FindFirstFileW(PerlDir_mapW(wbuffer), &wFindData);
}
else {
- fh = FindFirstFileA(scanname, &aFindData);
+ fh = FindFirstFileA(PerlDir_mapA(scanname), &aFindData);
}
dirp->handle = fh;
if (fh == INVALID_HANDLE_VALUE) {
getlogin(void)
{
dTHXo;
- char *buf = getlogin_buffer;
- DWORD size = sizeof(getlogin_buffer);
+ char *buf = w32_getlogin_buffer;
+ DWORD size = sizeof(w32_getlogin_buffer);
if (GetUserName(buf,&size))
return buf;
return (char*)NULL;
find_pid(int pid)
{
dTHXo;
- long child;
- for (child = 0 ; child < w32_num_children ; ++child) {
+ long child = w32_num_children;
+ while (--child >= 0) {
if (w32_child_pids[child] == pid)
return child;
}
}
}
+#ifdef USE_ITHREADS
+static long
+find_pseudo_pid(int pid)
+{
+ dTHXo;
+ long child = w32_num_pseudo_children;
+ while (--child >= 0) {
+ if (w32_pseudo_child_pids[child] == pid)
+ return child;
+ }
+ return -1;
+}
+
+static void
+remove_dead_pseudo_process(long child)
+{
+ if (child >= 0) {
+ dTHXo;
+ CloseHandle(w32_pseudo_child_handles[child]);
+ Copy(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
+ (w32_num_pseudo_children-child-1), HANDLE);
+ Copy(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
+ (w32_num_pseudo_children-child-1), DWORD);
+ w32_num_pseudo_children--;
+ }
+}
+#endif
+
DllExport int
win32_kill(int pid, int sig)
{
+ dTHXo;
HANDLE hProcess;
- hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
- if (hProcess && TerminateProcess(hProcess, sig))
- CloseHandle(hProcess);
- else {
- errno = EINVAL;
- return -1;
+#ifdef USE_ITHREADS
+ if (pid < 0) {
+ /* it is a pseudo-forked child */
+ long child = find_pseudo_pid(-pid);
+ if (child >= 0) {
+ hProcess = w32_pseudo_child_handles[child];
+ if (TerminateThread(hProcess, sig)) {
+ remove_dead_pseudo_process(child);
+ return 0;
+ }
+ }
}
- return 0;
+ else
+#endif
+ {
+ long child = find_pid(pid);
+ if (child >= 0) {
+ hProcess = w32_child_handles[child];
+ if (TerminateProcess(hProcess, sig)) {
+ remove_dead_process(child);
+ return 0;
+ }
+ }
+ else {
+ hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+ if (hProcess && TerminateProcess(hProcess, sig)) {
+ CloseHandle(hProcess);
+ return 0;
+ }
+ }
+ }
+ errno = EINVAL;
+ return -1;
}
/*
int l = strlen(path);
int res;
WCHAR wbuffer[MAX_PATH];
+ HANDLE handle;
+ int nlink = 1;
if (l > 1) {
switch(path[l - 1]) {
break;
}
}
+
+ /* We *must* open & close the file once; otherwise file attribute changes */
+ /* might not yet have propagated to "other" hard links of the same file. */
+ /* This also gives us an opportunity to determine the number of links. */
if (USING_WIDE()) {
A2WHELPER(path, wbuffer, sizeof(wbuffer));
+ wcscpy(wbuffer, PerlDir_mapW(wbuffer));
+ handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
+ }
+ else {
+ path = PerlDir_mapA(path);
+ handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
+ }
+ if (handle != INVALID_HANDLE_VALUE) {
+ BY_HANDLE_FILE_INFORMATION bhi;
+ if (GetFileInformationByHandle(handle, &bhi))
+ nlink = bhi.nNumberOfLinks;
+ CloseHandle(handle);
+ }
+
+ /* wbuffer or path will be mapped correctly above */
+ if (USING_WIDE()) {
res = _wstat(wbuffer, (struct _stat *)buffer);
}
else {
res = stat(path, buffer);
}
+ buffer->st_nlink = nlink;
+
if (res < 0) {
/* CRT is buggy on sharenames, so make sure it really isn't.
* XXX using GetFileAttributesEx() will enable us to set
New(1309,wCuritem,length,WCHAR);
A2WHELPER(name, wCuritem, length*sizeof(WCHAR));
wVal = wcschr(wCuritem, '=');
- if(wVal) {
+ if (wVal) {
*wVal++ = '\0';
- if(SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
+ if (SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
relval = 0;
}
Safefree(wCuritem);
New(1309,curitem,strlen(name)+1,char);
strcpy(curitem, name);
val = strchr(curitem, '=');
- if(val) {
+ if (val) {
/* The sane way to deal with the environment.
* Has these advantages over putenv() & co.:
* * enables us to store a truly empty value in the
* GSAR 97-06-07
*/
*val++ = '\0';
- if(SetEnvironmentVariableA(curitem, *val ? val : NULL))
+ if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
relval = 0;
}
Safefree(curitem);
static long
filetime_to_clock(PFILETIME ft)
{
- __int64 qw = ft->dwHighDateTime;
- qw <<= 32;
- qw |= ft->dwLowDateTime;
- qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
- return (long) qw;
+ __int64 qw = ft->dwHighDateTime;
+ qw <<= 32;
+ qw |= ft->dwLowDateTime;
+ qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
+ return (long) qw;
}
DllExport int
}
DllExport int
+win32_unlink(const char *filename)
+{
+ dTHXo;
+ int ret;
+ DWORD attrs;
+
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+
+ A2WHELPER(filename, wBuffer, sizeof(wBuffer));
+ wcscpy(wBuffer, PerlDir_mapW(wBuffer));
+ attrs = GetFileAttributesW(wBuffer);
+ if (attrs & FILE_ATTRIBUTE_READONLY) {
+ (void)SetFileAttributesW(wBuffer, attrs & ~FILE_ATTRIBUTE_READONLY);
+ ret = _wunlink(wBuffer);
+ if (ret == -1)
+ (void)SetFileAttributesW(wBuffer, attrs);
+ }
+ else
+ ret = _wunlink(wBuffer);
+ }
+ else {
+ filename = PerlDir_mapA(filename);
+ attrs = GetFileAttributesA(filename);
+ if (attrs & FILE_ATTRIBUTE_READONLY) {
+ (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
+ ret = unlink(filename);
+ if (ret == -1)
+ (void)SetFileAttributesA(filename, attrs);
+ }
+ else
+ ret = unlink(filename);
+ }
+ return ret;
+}
+
+DllExport int
win32_utime(const char *filename, struct utimbuf *times)
{
dTHXo;
int rc;
if (USING_WIDE()) {
A2WHELPER(filename, wbuffer, sizeof(wbuffer));
+ wcscpy(wbuffer, PerlDir_mapW(wbuffer));
rc = _wutime(wbuffer, (struct _utimbuf*)times);
}
else {
+ filename = PerlDir_mapA(filename);
rc = utime(filename, times);
}
/* EACCES: path specifies directory or readonly file */
{
dTHXo;
int retval = -1;
- if (pid == -1)
+ if (pid == -1) /* XXX threadid == 1 ? */
return win32_wait(status);
+#ifdef USE_ITHREADS
+ else if (pid < 0) {
+ long child = find_pseudo_pid(-pid);
+ if (child >= 0) {
+ HANDLE hThread = w32_pseudo_child_handles[child];
+ DWORD waitcode = WaitForSingleObject(hThread, INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (GetExitCodeThread(hThread, &waitcode)) {
+ *status = (int)((waitcode & 0xff) << 8);
+ retval = (int)w32_pseudo_child_pids[child];
+ remove_dead_pseudo_process(child);
+ return retval;
+ }
+ }
+ else
+ errno = ECHILD;
+ }
+ }
+#endif
else {
long child = find_pid(pid);
if (child >= 0) {
int i, retval;
DWORD exitcode, waitcode;
+#ifdef USE_ITHREADS
+ if (w32_num_pseudo_children) {
+ waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
+ w32_pseudo_child_handles,
+ FALSE,
+ INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (waitcode >= WAIT_ABANDONED_0
+ && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
+ i = waitcode - WAIT_ABANDONED_0;
+ else
+ i = waitcode - WAIT_OBJECT_0;
+ if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
+ *status = (int)((exitcode & 0xff) << 8);
+ retval = (int)w32_pseudo_child_pids[i];
+ remove_dead_pseudo_process(i);
+ return retval;
+ }
+ }
+ }
+#endif
+
if (!w32_num_children) {
errno = ECHILD;
return -1;
return 0;
}
-#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
#ifdef HAVE_DES_FCRYPT
extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
#endif
dTHXo;
#ifdef HAVE_DES_FCRYPT
dTHR;
- return des_fcrypt(txt, salt, crypt_buffer);
+ return des_fcrypt(txt, salt, w32_crypt_buffer);
#else
- die("The crypt() function is unimplemented due to excessive paranoia.");
+ Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
return Nullch;
#endif
}
-#endif
#ifdef USE_FIXED_OSFHANDLE
e = GetLastError();
if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
- strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
- strcpy(strerror_buffer, "Unknown Error");
+ w32_strerror_buffer,
+ sizeof(w32_strerror_buffer), NULL) == 0)
+ strcpy(w32_strerror_buffer, "Unknown Error");
- return strerror_buffer;
+ return w32_strerror_buffer;
}
return strerror(e);
}
if (USING_WIDE()) {
A2WHELPER(mode, wMode, sizeof(wMode));
A2WHELPER(filename, wBuffer, sizeof(wBuffer));
- return _wfopen(wBuffer, wMode);
+ return _wfopen(PerlDir_mapW(wBuffer), wMode);
}
- return fopen(filename, mode);
+ return fopen(PerlDir_mapA(filename), mode);
}
#ifndef USE_SOCKETS_AS_HANDLES
if (USING_WIDE()) {
A2WHELPER(mode, wMode, sizeof(wMode));
A2WHELPER(path, wBuffer, sizeof(wBuffer));
- return _wfreopen(wBuffer, wMode, stream);
+ return _wfreopen(PerlDir_mapW(wBuffer), wMode, stream);
}
- return freopen(path, mode, stream);
+ return freopen(PerlDir_mapA(path), mode, stream);
}
DllExport int
#endif /* USE_RTL_POPEN */
}
+static BOOL WINAPI
+Nt4CreateHardLinkW(
+ LPCWSTR lpFileName,
+ LPCWSTR lpExistingFileName,
+ LPSECURITY_ATTRIBUTES lpSecurityAttributes)
+{
+ HANDLE handle;
+ WCHAR wFullName[MAX_PATH+1];
+ LPVOID lpContext = NULL;
+ WIN32_STREAM_ID StreamId;
+ DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId;
+ DWORD dwWritten;
+ DWORD dwLen;
+ BOOL bSuccess;
+
+ BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD,
+ BOOL, BOOL, LPVOID*) =
+ (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD,
+ BOOL, BOOL, LPVOID*))
+ GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite");
+ if (pfnBackupWrite == NULL)
+ return 0;
+
+ dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL);
+ if (dwLen == 0)
+ return 0;
+ dwLen = (dwLen+1)*sizeof(WCHAR);
+
+ handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES,
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+ NULL, OPEN_EXISTING, 0, NULL);
+ if (handle == INVALID_HANDLE_VALUE)
+ return 0;
+
+ StreamId.dwStreamId = BACKUP_LINK;
+ StreamId.dwStreamAttributes = 0;
+ StreamId.dwStreamNameSize = 0;
+#ifdef __BORLANDC__
+ StreamId.Size.u.HighPart = 0;
+ StreamId.Size.u.LowPart = dwLen;
+#else
+ StreamId.Size.HighPart = 0;
+ StreamId.Size.LowPart = dwLen;
+#endif
+
+ bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
+ FALSE, FALSE, &lpContext);
+ if (bSuccess) {
+ bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten,
+ FALSE, FALSE, &lpContext);
+ pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext);
+ }
+
+ CloseHandle(handle);
+ return bSuccess;
+}
+
+DllExport int
+win32_link(const char *oldname, const char *newname)
+{
+ dTHXo;
+ BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
+ WCHAR wOldName[MAX_PATH];
+ WCHAR wNewName[MAX_PATH];
+
+ if (IsWin95())
+ Perl_die(aTHX_ PL_no_func, "link");
+
+ pfnCreateHardLinkW =
+ (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES))
+ GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW");
+ if (pfnCreateHardLinkW == NULL)
+ pfnCreateHardLinkW = Nt4CreateHardLinkW;
+
+ if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) &&
+ (A2WHELPER(newname, wNewName, sizeof(wNewName))) &&
+ (wcscpy(wOldName, PerlDir_mapW(wOldName)),
+ pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
+ {
+ return 0;
+ }
+ errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
+ return -1;
+}
+
DllExport int
win32_rename(const char *oname, const char *newname)
{
WCHAR wOldName[MAX_PATH];
WCHAR wNewName[MAX_PATH];
+ char szOldName[MAX_PATH];
BOOL bResult;
/* XXX despite what the documentation says about MoveFileEx(),
* it doesn't work under Windows95!
if (USING_WIDE()) {
A2WHELPER(oname, wOldName, sizeof(wOldName));
A2WHELPER(newname, wNewName, sizeof(wNewName));
- bResult = MoveFileExW(wOldName,wNewName,
+ wcscpy(wOldName, PerlDir_mapW(wOldName));
+ bResult = MoveFileExW(wOldName,PerlDir_mapW(wNewName),
MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
}
else {
- bResult = MoveFileExA(oname,newname,
+ strcpy(szOldName, PerlDir_mapA(szOldName));
+ bResult = MoveFileExA(szOldName,PerlDir_mapA(newname),
MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
}
if (!bResult) {
if (USING_WIDE()) {
A2WHELPER(path, wBuffer, sizeof(wBuffer));
- return _wopen(wBuffer, flag, pmode);
+ return _wopen(PerlDir_mapW(wBuffer), flag, pmode);
}
- return open(path,flag,pmode);
+ return open(PerlDir_mapA(path), flag, pmode);
}
DllExport int
DllExport int
win32_mkdir(const char *dir, int mode)
{
- return mkdir(dir); /* just ignore mode */
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wmkdir(PerlDir_mapW(wBuffer));
+ }
+ return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
}
DllExport int
win32_rmdir(const char *dir)
{
- return rmdir(dir);
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wrmdir(PerlDir_mapW(wBuffer));
+ }
+ return rmdir(PerlDir_mapA(dir));
}
DllExport int
win32_chdir(const char *dir)
{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wchdir(wBuffer);
+ }
return chdir(dir);
}
+DllExport int
+win32_access(const char *path, int mode)
+{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(path, wBuffer, sizeof(wBuffer));
+ return _waccess(PerlDir_mapW(wBuffer), mode);
+ }
+ return access(PerlDir_mapA(path), mode);
+}
+
+DllExport int
+win32_chmod(const char *path, int mode)
+{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(path, wBuffer, sizeof(wBuffer));
+ return _wchmod(PerlDir_mapW(wBuffer), mode);
+ }
+ return chmod(PerlDir_mapA(path), mode);
+}
+
+
static char *
create_command_line(const char* command, const char * const *args)
{
char*
get_childdir(void)
{
- return NULL;
+ dTHXo;
+ char* ptr;
+ char szfilename[(MAX_PATH+1)*2];
+ if (USING_WIDE()) {
+ WCHAR wfilename[MAX_PATH+1];
+ GetCurrentDirectoryW(MAX_PATH+1, wfilename);
+ W2AHELPER(wfilename, szfilename, sizeof(szfilename));
+ }
+ else {
+ GetCurrentDirectoryA(MAX_PATH+1, szfilename);
+ }
+
+ New(0, ptr, strlen(szfilename)+1, char);
+ strcpy(ptr, szfilename);
+ return ptr;
}
void
free_childdir(char* d)
{
+ dTHXo;
+ Safefree(d);
}
return spawnvp(mode, cmdname, (char * const *)argv);
#else
dTHXo;
- DWORD ret;
+ int ret;
void* env;
char* dir;
STARTUPINFO StartupInfo;
if (mode == P_NOWAIT) {
/* asynchronous spawn -- store handle, return PID */
w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
- ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
+ w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
+ ret = (int)ProcessInformation.dwProcessId;
++w32_num_children;
}
else {
+ DWORD status;
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
- GetExitCodeProcess(ProcessInformation.hProcess, &ret);
+ GetExitCodeProcess(ProcessInformation.hProcess, &status);
+ ret = (int)status;
CloseHandle(ProcessInformation.hProcess);
}
PerlEnv_free_childdir(dir);
Safefree(cmd);
Safefree(fullcmd);
- return (int)ret;
+ return ret;
#endif
}
DllExport int
win32_execv(const char *cmdname, const char *const *argv)
{
+#ifdef USE_ITHREADS
+ dTHXo;
+ /* if this is a pseudo-forked child, we just want to spawn
+ * the new program, and return */
+ if (w32_pseudo_id)
+ return spawnv(P_WAIT, cmdname, (char *const *)argv);
+#endif
return execv(cmdname, (char *const *)argv);
}
DllExport int
win32_execvp(const char *cmdname, const char *const *argv)
{
+#ifdef USE_ITHREADS
+ dTHXo;
+ /* if this is a pseudo-forked child, we just want to spawn
+ * the new program, and return */
+ if (w32_pseudo_id)
+ return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv);
+#endif
return execvp(cmdname, (char *const *)argv);
}
if (USING_WIDE()) {
WCHAR wfilename[MAX_PATH];
A2WHELPER(filename, wfilename, sizeof(wfilename));
- hModule = LoadLibraryExW(wfilename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
+ hModule = LoadLibraryExW(PerlDir_mapW(wfilename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
}
else {
- hModule = LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
+ hModule = LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
}
return hModule;
}
-DllExport int
-win32_add_host(char *nameId, void *data)
-{
- /*
- * This must be called before the script is parsed,
- * therefore no locking of threads is needed
- */
- dTHXo;
- struct host_link *link;
- New(1314, link, 1, struct host_link);
- link->host_data = data;
- link->nameId = nameId;
- link->next = w32_host_link;
- w32_host_link = link;
- return 1;
-}
-
-DllExport void *
-win32_get_host_data(char *nameId)
-{
- dTHXo;
- struct host_link *link = w32_host_link;
- while(link) {
- if(strEQ(link->nameId, nameId))
- return link->host_data;
- link = link->next;
- }
- return Nullch;
-}
-
/*
* Extras.
*/
XS(w32_GetCwd)
{
dXSARGS;
- SV *sv = sv_newmortal();
- /* Make one call with zero size - return value is required size */
- DWORD len = GetCurrentDirectory((DWORD)0,NULL);
- SvUPGRADE(sv,SVt_PV);
- SvGROW(sv,len);
- SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
+ /* Make the host for current directory */
+ char* ptr = PerlEnv_get_childdir();
/*
- * If result != 0
+ * If ptr != Nullch
* then it worked, set PV valid,
- * else leave it 'undef'
+ * else return 'undef'
*/
- EXTEND(SP,1);
- if (SvCUR(sv)) {
+ if (ptr) {
+ SV *sv = sv_newmortal();
+ sv_setpv(sv, ptr);
+ PerlEnv_free_childdir(ptr);
+
+ EXTEND(SP,1);
SvPOK_on(sv);
ST(0) = sv;
XSRETURN(1);
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV_nolen(ST(0))))
+ if (!PerlDir_chdir(SvPV_nolen(ST(0))))
XSRETURN_YES;
XSRETURN_NO;
XS(w32_LoginName)
{
dXSARGS;
- char *name = getlogin_buffer;
- DWORD size = sizeof(getlogin_buffer);
+ char *name = w32_getlogin_buffer;
+ DWORD size = sizeof(w32_getlogin_buffer);
EXTEND(SP,1);
if (GetUserName(name,&size)) {
/* size includes NULL */
XS(w32_DomainName)
{
dXSARGS;
-#ifndef HAS_NETWKSTAGETINFO
- /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
- char name[256];
- DWORD size = sizeof(name);
+ HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
+ DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
+ DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
+ void *bufptr);
+
+ if (hNetApi32) {
+ pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
+ GetProcAddress(hNetApi32, "NetApiBufferFree");
+ pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
+ GetProcAddress(hNetApi32, "NetWkstaGetInfo");
+ }
EXTEND(SP,1);
- if (GetUserName(name,&size)) {
- char sid[1024];
- DWORD sidlen = sizeof(sid);
+ if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
+ /* this way is more reliable, in case user has a local account. */
char dname[256];
DWORD dnamelen = sizeof(dname);
- SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
- dname, &dnamelen, &snu)) {
- XSRETURN_PV(dname); /* all that for this */
+ struct {
+ DWORD wki100_platform_id;
+ LPWSTR wki100_computername;
+ LPWSTR wki100_langroup;
+ DWORD wki100_ver_major;
+ DWORD wki100_ver_minor;
+ } *pwi;
+ /* NERR_Success *is* 0*/
+ if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
+ if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+ WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ else {
+ WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
+ -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ }
+ pfnNetApiBufferFree(pwi);
+ FreeLibrary(hNetApi32);
+ XSRETURN_PV(dname);
}
+ FreeLibrary(hNetApi32);
}
-#else
- /* this way is more reliable, in case user has a local account.
- * XXX need dynamic binding of netapi32.dll symbols or this will fail on
- * Win95. Probably makes more sense to move it into libwin32. */
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- PWKSTA_INFO_100 pwi;
- EXTEND(SP,1);
- if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
- if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
- }
- else {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
- -1, (LPSTR)dname, dnamelen, NULL, NULL);
+ else {
+ /* Win95 doesn't have NetWksta*(), so do it the old way */
+ char name[256];
+ DWORD size = sizeof(name);
+ if (hNetApi32)
+ FreeLibrary(hNetApi32);
+ if (GetUserName(name,&size)) {
+ char sid[ONE_K_BUFSIZE];
+ DWORD sidlen = sizeof(sid);
+ char dname[256];
+ DWORD dnamelen = sizeof(dname);
+ SID_NAME_USE snu;
+ if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
+ dname, &dnamelen, &snu)) {
+ XSRETURN_PV(dname); /* all that for this */
+ }
}
- NetApiBufferFree(pwi);
- XSRETURN_PV(dname);
}
-#endif
XSRETURN_UNDEF;
}
XS(w32_GetOSVersion)
{
dXSARGS;
- OSVERSIONINFO osver;
+ OSVERSIONINFOA osver;
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- if (GetVersionEx(&osver)) {
+ if (USING_WIDE()) {
+ OSVERSIONINFOW osverw;
+ char szCSDVersion[sizeof(osverw.szCSDVersion)];
+ osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+ if (!GetVersionExW(&osverw)) {
+ XSRETURN_EMPTY;
+ }
+ W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
+ XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
+ osver.dwMajorVersion = osverw.dwMajorVersion;
+ osver.dwMinorVersion = osverw.dwMinorVersion;
+ osver.dwBuildNumber = osverw.dwBuildNumber;
+ osver.dwPlatformId = osverw.dwPlatformId;
+ }
+ else {
+ osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ if (!GetVersionExA(&osver)) {
+ XSRETURN_EMPTY;
+ }
XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
- XPUSHs(newSViv(osver.dwMajorVersion));
- XPUSHs(newSViv(osver.dwMinorVersion));
- XPUSHs(newSViv(osver.dwBuildNumber));
- XPUSHs(newSViv(osver.dwPlatformId));
- PUTBACK;
- return;
}
- XSRETURN_EMPTY;
+ XPUSHs(newSViv(osver.dwMajorVersion));
+ XPUSHs(newSViv(osver.dwMinorVersion));
+ XPUSHs(newSViv(osver.dwBuildNumber));
+ XPUSHs(newSViv(osver.dwPlatformId));
+ PUTBACK;
}
static
{
dXSARGS;
DWORD source = 0;
- char msgbuf[1024];
+ char msgbuf[ONE_K_BUFSIZE];
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
- if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
- &source, SvIV(ST(0)), 0,
- msgbuf, sizeof(msgbuf)-1, NULL))
- XSRETURN_PV(msgbuf);
+ if (USING_WIDE()) {
+ WCHAR wmsgbuf[ONE_K_BUFSIZE];
+ if (FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, SvIV(ST(0)), 0,
+ wmsgbuf, ONE_K_BUFSIZE-1, NULL))
+ {
+ W2AHELPER(wmsgbuf, msgbuf, sizeof(msgbuf));
+ XSRETURN_PV(msgbuf);
+ }
+ }
+ else {
+ if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, SvIV(ST(0)), 0,
+ msgbuf, sizeof(msgbuf)-1, NULL))
+ XSRETURN_PV(msgbuf);
+ }
XSRETURN_UNDEF;
}
XS(w32_CopyFile)
{
dXSARGS;
+ BOOL bResult;
if (items != 3)
Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
- if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2))))
+ if (USING_WIDE()) {
+ WCHAR wSourceFile[MAX_PATH];
+ WCHAR wDestFile[MAX_PATH];
+ A2WHELPER(SvPV_nolen(ST(0)), wSourceFile, sizeof(wSourceFile));
+ wcscpy(wSourceFile, PerlDir_mapW(wSourceFile));
+ A2WHELPER(SvPV_nolen(ST(1)), wDestFile, sizeof(wDestFile));
+ bResult = CopyFileW(wSourceFile, PerlDir_mapW(wDestFile), !SvTRUE(ST(2)));
+ }
+ else {
+ char szSourceFile[MAX_PATH];
+ strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
+ bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
+ }
+
+ if (bResult)
XSRETURN_YES;
XSRETURN_NO;
}
w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
New(1313, w32_children, 1, child_tab);
w32_num_children = 0;
+ w32_init_socktype = 0;
+#ifdef USE_ITHREADS
+ w32_pseudo_id = 0;
+ New(1313, w32_pseudo_children, 1, child_tab);
+ w32_num_pseudo_children = 0;
+#endif
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
#endif
+#ifdef USE_ITHREADS
+
+# ifdef PERL_OBJECT
+# undef Perl_sys_intern_dup
+# define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
+# define pPerl this
+# endif
+
+void
+Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
+{
+ dst->perlshell_tokens = Nullch;
+ dst->perlshell_vec = (char**)NULL;
+ dst->perlshell_items = 0;
+ dst->fdpid = newAV();
+ Newz(1313, dst->children, 1, child_tab);
+ Newz(1313, dst->pseudo_children, 1, child_tab);
+ dst->pseudo_id = 0;
+ dst->children->num = 0;
+ dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
+}
+#endif
+
#ifndef _INC_WIN32_PERL5
#define _INC_WIN32_PERL5
+#define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */
+
#if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI)
# define DYNAMIC_ENV_FETCH
# define ENV_HV_NAME "___ENV_HV_NAME___"
#define _access access
#define _chdir chdir
+#define _getpid getpid
#include <sys/types.h>
#ifndef DllMain
#define flushall _flushall
#define fcloseall _fcloseall
-#ifdef PERL_OBJECT
-# define MEMBER_TO_FPTR(name) &(name)
+#undef __attribute__
+#define __attribute__(x)
+
+#ifndef CP_UTF8
+# define CP_UTF8 65001
#endif
-#ifndef _O_NOINHERIT
-# define _O_NOINHERIT 0x0080
-# ifndef _NO_OLDNAMES
-# define O_NOINHERIT _O_NOINHERIT
-# endif
+#ifdef PERL_OBJECT
+# define MEMBER_TO_FPTR(name) &(name)
#endif
#ifndef _O_NOINHERIT
#define win32_strip_return(sv) NOOP
#endif
+/*
+ * Now Win32 specific per-thread data stuff
+ */
+
+struct thread_intern {
+ /* XXX can probably use one buffer instead of several */
+ char Wstrerror_buffer[512];
+ struct servent Wservent;
+ char Wgetlogin_buffer[128];
+# ifdef USE_SOCKETS_AS_HANDLES
+ int Winit_socktype;
+# endif
+# ifdef HAVE_DES_FCRYPT
+ char Wcrypt_buffer[30];
+# endif
+# ifdef USE_RTL_THREAD_API
+ void * retv; /* slot for thread return value */
+# endif
+};
+
+#ifdef USE_THREADS
+# ifndef USE_DECLSPEC_THREAD
+# define HAVE_THREAD_INTERN
+# endif /* !USE_DECLSPEC_THREAD */
+#endif /* USE_THREADS */
+
#define HAVE_INTERP_INTERN
typedef struct {
long num;
DWORD pids[MAXIMUM_WAIT_OBJECTS];
+ HANDLE handles[MAXIMUM_WAIT_OBJECTS];
} child_tab;
-struct host_link {
- char * nameId;
- void * host_data;
- struct host_link * next;
-};
-
struct interp_intern {
char * perlshell_tokens;
char ** perlshell_vec;
long perlshell_items;
struct av * fdpid;
child_tab * children;
- HANDLE child_handles[MAXIMUM_WAIT_OBJECTS];
- struct host_link * hostlist;
+#ifdef USE_ITHREADS
+ DWORD pseudo_id;
+ child_tab * pseudo_children;
+#endif
+ void * internal_host;
+#ifndef USE_THREADS
+ struct thread_intern thr_intern;
+#endif
};
#define w32_children (PL_sys_intern.children)
#define w32_num_children (w32_children->num)
#define w32_child_pids (w32_children->pids)
-#define w32_child_handles (PL_sys_intern.child_handles)
-#define w32_host_link (PL_sys_intern.hostlist)
-
-/*
- * Now Win32 specific per-thread data stuff
- */
-
+#define w32_child_handles (w32_children->handles)
+#define w32_pseudo_id (PL_sys_intern.pseudo_id)
+#define w32_pseudo_children (PL_sys_intern.pseudo_children)
+#define w32_num_pseudo_children (w32_pseudo_children->num)
+#define w32_pseudo_child_pids (w32_pseudo_children->pids)
+#define w32_pseudo_child_handles (w32_pseudo_children->handles)
+#define w32_internal_host (PL_sys_intern.internal_host)
#ifdef USE_THREADS
-# ifndef USE_DECLSPEC_THREAD
-# define HAVE_THREAD_INTERN
-
-struct thread_intern {
- /* XXX can probably use one buffer instead of several */
- char Wstrerror_buffer[512];
- struct servent Wservent;
- char Wgetlogin_buffer[128];
- char Ww32_perllib_root[MAX_PATH+1];
-# ifdef USE_SOCKETS_AS_HANDLES
- int Winit_socktype;
-# endif
-# ifdef HAVE_DES_FCRYPT
- char Wcrypt_buffer[30];
-# endif
-# ifdef USE_RTL_THREAD_API
- void * retv; /* slot for thread return value */
-# endif
-};
-# endif /* !USE_DECLSPEC_THREAD */
+# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
+# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
+# define w32_crypt_buffer (thr->i.Wcrypt_buffer)
+# define w32_servent (thr->i.Wservent)
+# define w32_init_socktype (thr->i.Winit_socktype)
+#else
+# define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
+# define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+# define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
+# define w32_servent (PL_sys_intern.thr_intern.Wservent)
+# define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
#endif /* USE_THREADS */
/* UNICODE<>ANSI translation helpers */
#define USING_WIDE() (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
+#ifdef USE_ITHREADS
+# define PERL_WAIT_FOR_CHILDREN \
+ STMT_START { \
+ if (w32_pseudo_children && w32_num_pseudo_children) { \
+ long children = w32_num_pseudo_children; \
+ WaitForMultipleObjects(children, \
+ w32_pseudo_child_handles, \
+ TRUE, INFINITE); \
+ while (children) \
+ CloseHandle(w32_pseudo_child_handles[--children]); \
+ } \
+ } STMT_END
+#endif
+
/*
* This provides a layer of functions and macros to ensure extensions will
* get to use the same RTL functions as the core.
DllExport int win32_stat(const char *path, struct stat *buf);
DllExport char* win32_longpath(char *path);
DllExport int win32_ioctl(int i, unsigned int u, char *data);
+DllExport int win32_link(const char *oldname, const char *newname);
+DllExport int win32_unlink(const char *f);
DllExport int win32_utime(const char *f, struct utimbuf *t);
DllExport int win32_uname(struct utsname *n);
DllExport int win32_wait(int *status);
DllExport int win32_kill(int pid, int sig);
DllExport unsigned long win32_os_id(void);
DllExport void* win32_dynaload(const char*filename);
+DllExport int win32_access(const char *path, int mode);
+DllExport int win32_chmod(const char *path, int mode);
+DllExport int win32_getpid(void);
-#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
DllExport char * win32_crypt(const char *txt, const char *salt);
-#endif
END_EXTERN_C
#undef times
#undef alarm
#undef ioctl
+#undef unlink
#undef utime
#undef uname
#undef wait
#define getchar win32_getchar
#undef putchar
#define putchar win32_putchar
+#define access(p,m) win32_access(p,m)
+#define chmod(p,m) win32_chmod(p,m)
+
#if !defined(MYMALLOC) || !defined(PERL_CORE)
#undef malloc
#define times win32_times
#define alarm win32_alarm
#define ioctl win32_ioctl
+#define link win32_link
+#define unlink win32_unlink
#define utime win32_utime
#define uname win32_uname
#define wait win32_wait
#define rewinddir win32_rewinddir
#define closedir win32_closedir
#define os_id win32_os_id
+#define getpid win32_getpid
-#ifdef HAVE_DES_FCRYPT
#undef crypt
-#define crypt win32_crypt
-#endif
+#define crypt(t,s) win32_crypt(t,s)
#ifndef USE_WIN32_RTL_ENV
#undef getenv
struct servent*s,
const char *proto);
-#ifdef USE_THREADS
-#ifdef USE_DECLSPEC_THREAD
-__declspec(thread) struct servent myservent;
-__declspec(thread) int init_socktype;
-#else
-#define myservent (thr->i.Wservent)
-#define init_socktype (thr->i.Winit_socktype)
-#endif
-#else
-static struct servent myservent;
-#endif
-
static int wsock_started = 0;
void
#ifdef USE_SOCKETS_AS_HANDLES
#ifdef USE_THREADS
dTHX;
- if(!init_socktype) {
+ if (!w32_init_socktype) {
#endif
- int iSockOpt = SO_SYNCHRONOUS_NONALERT;
- /*
- * Enable the use of sockets as filehandles
- */
- setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *)&iSockOpt, sizeof(iSockOpt));
+ int iSockOpt = SO_SYNCHRONOUS_NONALERT;
+ /*
+ * Enable the use of sockets as filehandles
+ */
+ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+ (char *)&iSockOpt, sizeof(iSockOpt));
#ifdef USE_THREADS
- init_socktype = 1;
+ w32_init_socktype = 1;
}
#endif
#endif /* USE_SOCKETS_AS_HANDLES */
SOCKET_TEST(r = getservbyname(name, proto), NULL);
if (r) {
- r = win32_savecopyservent(&myservent, r, proto);
+ r = win32_savecopyservent(&w32_servent, r, proto);
}
return r;
}
SOCKET_TEST(r = getservbyport(port, proto), NULL);
if (r) {
- r = win32_savecopyservent(&myservent, r, proto);
+ r = win32_savecopyservent(&w32_servent, r, proto);
}
return r;
}
#ifndef _WIN32THREAD_H
#define _WIN32THREAD_H
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
+#include "win32.h"
typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
typedef DWORD perl_key;
if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
|| (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
|| (CloseHandle((t)->self) == 0)) \
- Perl_croak(aTHX_ "panic: JOIN"); \
+ Perl_croak(aTHX_ "panic: JOIN"); \
} STMT_END
#endif /* !USE_RTL_THREAD_API || _MSC_VER */
str_scat(tmp3str,tmp2str);
str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, ");
str_set(tmp2str,"eval $s_");
- s = (*s == 'g' ? "ge" : "e");
+ s = (char*)(*s == 'g' ? "ge" : "e");
i++;
}
type = ops[ops[node+1].ival].ival;
}
tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
if (!*tmpstr->str_ptr && lval_field) {
- t = saw_OFS ? "$," : "' '";
+ t = (char*)(saw_OFS ? "$," : "' '");
if (split_to_array) {
sprintf(tokenbuf,"join(%s,@Fld)",t);
str_cat(tmpstr,tokenbuf);
tmpstr = str_new(0);
if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
if (lval_field) {
- t = saw_OFS ? "$," : "' '";
+ t = (char*)(saw_OFS ? "$," : "' '");
if (split_to_array) {
sprintf(tokenbuf,"join(%s,@Fld)",t);
str_cat(tmpstr,tokenbuf);
newXS("attributes::bootstrap", XS_attributes_bootstrap, file);
}
-#ifdef PERL_OBJECT
-#define NO_XSLOCKS
-#endif /* PERL_OBJECT */
-
#include "XSUB.h"
static int
projects / platform / upstream / perl.git / commitdiff