summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes316
-rwxr-xr-xConfigure93
-rw-r--r--MANIFEST11
-rw-r--r--Makefile.SH29
-rw-r--r--bytecode.pl209
-rw-r--r--cc_runtime.h47
-rw-r--r--config_h.SH30
-rw-r--r--embed.h4
-rw-r--r--embedvar.h12
-rw-r--r--ext/B/B.pm7
-rw-r--r--ext/B/B.xs79
-rw-r--r--ext/B/B/Bytecode.pm13
-rw-r--r--ext/B/Makefile.PL21
-rw-r--r--ext/ByteLoader/ByteLoader.pm6
-rw-r--r--ext/ByteLoader/ByteLoader.xs28
-rw-r--r--ext/ByteLoader/Makefile.PL12
-rw-r--r--ext/ByteLoader/bytecode.h (renamed from bytecode.h)55
-rw-r--r--ext/ByteLoader/byterun.c (renamed from byterun.c)195
-rw-r--r--ext/ByteLoader/byterun.h (renamed from byterun.h)31
-rw-r--r--ext/IO/lib/IO/Handle.pm18
-rw-r--r--ext/IO/poll.c6
-rw-r--r--ext/NDBM_File/NDBM_File.xs34
-rw-r--r--ext/POSIX/POSIX.xs8
-rw-r--r--ext/Socket/Socket.xs25
-rw-r--r--global.sym2
-rw-r--r--hints/openbsd.sh20
-rw-r--r--hints/os2.sh49
-rw-r--r--hints/sunos_4_1.sh10
-rw-r--r--intrpvar.h6
-rw-r--r--lib/Carp.pm6
-rw-r--r--lib/Math/BigFloat.pm1
-rw-r--r--objXSUB.h16
-rw-r--r--op.c24
-rw-r--r--op.h1
-rw-r--r--opcode.h2
-rwxr-xr-xopcode.pl2
-rw-r--r--os2/Makefile.SHs8
-rw-r--r--os2/os2.c99
-rw-r--r--os2/os2ish.h7
-rw-r--r--perl.h2
-rw-r--r--perlvars.h3
-rw-r--r--pod/perldelta.pod12
-rw-r--r--pod/perldiag.pod12
-rw-r--r--pod/perlfunc.pod18
-rw-r--r--pod/perlvar.pod6
-rw-r--r--pp_proto.h1
-rw-r--r--pp_sys.c24
-rw-r--r--proto.h7
-rw-r--r--scope.h32
-rwxr-xr-xt/TEST8
-rwxr-xr-xt/io/pipe.t2
-rwxr-xr-xt/lib/bigfloatpm.t46
-rwxr-xr-xt/lib/io_linenum.t93
-rwxr-xr-xt/lib/io_sock.t2
-rw-r--r--t/lib/io_unix.t15
-rwxr-xr-xt/op/grent.t5
-rwxr-xr-xt/op/groups.t5
-rwxr-xr-xt/op/pwent.t5
-rwxr-xr-xt/op/stat.t51
-rw-r--r--t/pragma/warn/op45
-rw-r--r--util.c25
-rw-r--r--utils/Makefile8
62 files changed, 1229 insertions, 740 deletions
diff --git a/Changes b/Changes
index 169b0c8dea..8988a857b8 100644
--- a/Changes
+++ b/Changes
@@ -75,7 +75,321 @@ indicator:
----------------
-Version 5.005_57 Development release working toward 5.006
+Version 5.005_58 Development release working toward 5.006
+----------------
+
+____________________________________________________________________________
+[ 3515] By: gsar on 1999/06/02 00:48:50
+ Log: remove stray K&R-isms
+ Branch: perl
+ ! ext/SDBM_File/sdbm/dba.c ext/SDBM_File/sdbm/dbd.c
+ ! ext/SDBM_File/sdbm/dbe.c ext/SDBM_File/sdbm/dbm.c
+ ! ext/SDBM_File/sdbm/dbu.c mg.c op.c pp_ctl.c pp_sys.c sv.c
+ ! toke.c util.c win32/win32.c x2p/hash.c
+____________________________________________________________________________
+[ 3514] By: gsar on 1999/06/01 15:55:55
+ Log: change#3447 didn't do enough to exempt Foo->bar(qw/.../) from
+ strict 'subs'
+ Branch: perl
+ ! op.c t/pragma/strict-subs
+____________________________________________________________________________
+[ 3513] By: jhi on 1999/06/01 07:17:05
+ Log: Patch applying of #3499 had gone awry.
+ Branch: cfgperl
+ ! ext/ByteLoader/bytecode.h ext/ByteLoader/byterun.h
+____________________________________________________________________________
+[ 3512] By: gsar on 1999/05/31 19:21:30
+ Log: tighter -help output
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 3511] By: gsar on 1999/05/31 17:18:23
+ Log: fix memory leak in C<eval 'return sub {...}'>
+ Branch: perl
+ ! embed.h embed.pl objXSUB.h pp_ctl.c proto.h
+____________________________________________________________________________
+[ 3510] By: gsar on 1999/05/31 14:11:46
+ Log: tweak C++isms
+ Branch: perl
+ ! win32/dl_win32.xs win32/win32.c
+____________________________________________________________________________
+[ 3509] By: jhi on 1999/05/30 13:02:26
+ Log: Cleanup of #3488.
+ Branch: cfgperl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 3508] By: jhi on 1999/05/30 11:16:01
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: Mailing list Perl5 <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_57] Teach Socket and io_unix.t the syntax of OS/2
+ Date: Sat, 29 May 1999 20:18:13 -0400
+ Message-ID: <19990529201813.B9489@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! ext/Socket/Socket.xs os2/os2ish.h t/lib/io_unix.t
+____________________________________________________________________________
+[ 3507] By: jhi on 1999/05/29 20:05:40
+ Log: From: Mark-Jason Dominus <mjd@plover.com>
+ To: perl5-porters@perl.com
+ Subject: PATCH (5.005_57): Document use of `SPECIAL' flag for `pushre':
+ Date: Sat, 29 May 1999 14:45:10 -0400
+ Message-ID: <19990529184510.27557.qmail@plover.com>
+ Branch: cfgperl
+ ! op.h
+____________________________________________________________________________
+[ 3506] By: gsar on 1999/05/29 16:49:39
+ Log: avoid gv_check() recursive pit
+ Branch: perl
+ ! gv.c
+____________________________________________________________________________
+[ 3505] By: jhi on 1999/05/29 11:38:16
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ To: Gurusamy Sarathy <gsar@activestate.com>
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH 5.005_57]Safeguard against unimplemented functions in pwuid.t and grent.t
+ Date: Sat, 29 May 1999 08:46:22 +0200
+ Message-ID: <374f8007.2016008@smtp1.ibm.net>
+ Branch: cfgperl
+ ! t/op/grent.t t/op/pwent.t
+____________________________________________________________________________
+[ 3504] By: jhi on 1999/05/29 11:07:10
+ Log: QNX needs <sys/select.h> to define fd_set.
+
+ From: Norton Allen <allen@huarp.harvard.edu>
+ To: perl5-porters@perl.org
+ Subject: [19990526.016] Not OK: perl 5.00503 on x86-qnx 424
+ Date: Wed, 26 May 1999 13:51:27 -0400 (EDT)
+ Message-Id: <199905261751.NAA20966@bottesini.harvard.edu>
+ Branch: cfgperl
+ ! ext/IO/poll.c
+____________________________________________________________________________
+[ 3503] By: jhi on 1999/05/29 10:53:31
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ To: Gurusamy Sarathy <gsar@activestate.com>, perl5-porters@perl.org
+ Subject: [PATCH all versions] (was Re: Unitialized Value Complaints in Math::BigFloat)
+ Date: Fri, 28 May 1999 20:14:35 +0200
+ Message-ID: <3751daa4.7188847@smtp1.ibm.net>
+ Branch: cfgperl
+ ! lib/Math/BigFloat.pm
+____________________________________________________________________________
+[ 3502] By: jhi on 1999/05/29 10:44:44
+ Log: Make Configure support the change #3367,
+ SysV shadow passwords.
+ Branch: cfgperl
+ ! Configure config_h.SH pp_sys.c
+____________________________________________________________________________
+[ 3501] By: gsar on 1999/05/28 21:22:23
+ Log: add wide versions of win32 system calls (first step in
+ globalization); delayload winsock for performance if compiling
+ with VC 6.0
+ Branch: perl
+ ! win32/Makefile win32/dl_win32.xs win32/makefile.mk
+ ! win32/win32.c win32/win32.h
+____________________________________________________________________________
+[ 3500] By: jhi on 1999/05/28 21:17:24
+ Log: The new t/lib/io_linenum.t was using stricture
+ before @INC was set up.
+ Branch: cfgperl
+ ! t/lib/io_linenum.t
+____________________________________________________________________________
+[ 3499] By: jhi on 1999/05/28 17:13:23
+ Log: From: Tom Hughes <tom@compton.nu>
+ To: perl5-porters@perl.org
+ Subject: [PATCH 5.005_57] ByteLoader mark 2
+ Date: Wed, 26 May 1999 23:59:49 +0100
+ Message-ID: <bf337a0849.tom@compton.compton.nu>
+
+ plus resolve tiny conflict with #3479
+ plus regen_headers.
+ Branch: cfgperl
+ + ext/ByteLoader/bytecode.h ext/ByteLoader/byterun.c
+ + ext/ByteLoader/byterun.h
+ - bytecode.h byterun.c byterun.h
+ ! MANIFEST Makefile.SH bytecode.pl embed.h embedvar.h ext/B/B.pm
+ ! ext/B/B.xs ext/B/B/Bytecode.pm ext/B/Makefile.PL
+ ! ext/ByteLoader/ByteLoader.pm ext/ByteLoader/ByteLoader.xs
+ ! ext/ByteLoader/Makefile.PL global.sym intrpvar.h objXSUB.h
+ ! perl.h perlvars.h proto.h util.c utils/Makefile
+____________________________________________________________________________
+[ 3498] By: jhi on 1999/05/28 16:53:04
+ Log: From: Mark-Jason Dominus <mjd@plover.com>
+ To: perl5-porters@perl.com
+ Subject: PATCH (5.005_57): defined(@a) now deprecated
+ Date: Thu, 27 May 1999 16:05:44 -0400
+ Message-ID: <19990527200544.13330.qmail@plover.com>
+ Branch: cfgperl
+ ! lib/Carp.pm op.c opcode.h opcode.pl pod/perldelta.pod
+ ! pod/perldiag.pod pod/perlfunc.pod pp_proto.h t/pragma/warn/op
+____________________________________________________________________________
+[ 3497] By: jhi on 1999/05/28 16:50:54
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.00557] Cosmetic OS/2-related patches
+ Date: Fri, 28 May 1999 12:13:00 -0400 (EDT)
+ Message-Id: <199905281613.MAA02048@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! MANIFEST Makefile.SH ext/POSIX/POSIX.xs hints/os2.sh
+ ! os2/Makefile.SHs t/io/pipe.t t/lib/io_sock.t
+____________________________________________________________________________
+[ 3496] By: jhi on 1999/05/28 16:48:39
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: perl5-porters@perl.org (Mailing list Perl5)
+ Subject: [PATCH 5.00557] Required OS/2-related patches
+ Date: Fri, 28 May 1999 12:11:48 -0400 (EDT)
+ Message-Id: <199905281611.MAA02037@monk.mps.ohio-state.edu>
+ Branch: cfgperl
+ ! os2/os2.c t/lib/bigfloatpm.t t/lib/io_unix.t t/op/groups.t
+ ! t/op/stat.t util.c
+____________________________________________________________________________
+[ 3495] By: jhi on 1999/05/28 16:45:56
+ Log: From: Paul Johnson <pjcj@transeda.com>
+ To: perl5-porters <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_57] Provide more useful test okay percentage
+ Date: Fri, 28 May 1999 15:13:54 +0100
+ Message-ID: <19990528151354.B289@west-tip.transeda.com>
+ Branch: cfgperl
+ ! t/TEST
+____________________________________________________________________________
+[ 3494] By: jhi on 1999/05/28 16:44:34
+ Log: From: Paul Johnson <pjcj@transeda.com>
+ To: perl5-porters <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_57] Fixes related to working local $.
+ Date: Fri, 28 May 1999 15:11:18 +0100
+ Message-ID: <19990528151118.A289@west-tip.transeda.com>
+ Branch: cfgperl
+ ! ext/IO/lib/IO/Handle.pm pod/perlvar.pod t/lib/io_linenum.t
+____________________________________________________________________________
+[ 3493] By: gsar on 1999/05/28 16:37:26
+ Log: change#3449 wasn't doing enough
+ Branch: perl
+ ! op.c t/comp/proto.t
+____________________________________________________________________________
+[ 3492] By: jhi on 1999/05/28 08:12:23
+ Log: From: paul.marquess@bt.com
+ To: doughera@lafayette.edu
+ Cc: perl5-porters@perl.org
+ Subject: RE: [19990527.002] DBM Filters in _57 cause problems in NDBM_File
+ Date: Thu, 27 May 1999 23:31:38 +0100
+ Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB29C6C03@mbtlipnt02.btlabs.bt.co.uk>
+
+ Had to be applied manually; some mailer had munged the patch slightly.
+ Branch: cfgperl
+ ! ext/NDBM_File/NDBM_File.xs
+____________________________________________________________________________
+[ 3491] By: jhi on 1999/05/28 07:51:17
+ Log: From: "Vishal Bhatia" <vishalb@my-deja.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH 5.005_57] fixing eval in the compiler
+ Date: Thu, 27 May 1999 07:56:54 -0700
+ Message-ID: <JDIKFDKKLGHHBAAA@my-deja.com>
+ Branch: cfgperl
+ ! cc_runtime.h scope.h
+____________________________________________________________________________
+[ 3490] By: jhi on 1999/05/28 07:47:06
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ To: perlbug@perl.com
+ Cc: Jarkko Hietaniemi <jhi@iki.fi>
+ Subject: [PATCH] Configure updates for ISC 4.1
+ Date: Thu, 27 May 1999 15:19:21 -0400 (EDT)
+ Message-Id: <Pine.GSU.4.05.9905271513500.22115-100000@newton.phys>
+ Branch: cfgperl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 3489] By: jhi on 1999/05/28 07:39:17
+ Log: Integrate from mainperl.
+ Branch: cfgperl
+ !> malloc.c win32/makedef.pl win32/win32.c
+____________________________________________________________________________
+[ 3488] By: jhi on 1999/05/27 16:57:19
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ To: Perl Porters <perl5-porters@perl.org>
+ Subject: [PATCH] Re: 5.005_57 NOT OK on SunOS 4.1.3
+ Date: Thu, 27 May 1999 12:26:28 -0400 (EDT)
+ Message-Id: <Pine.GSU.4.05.9905271120230.22115-100000@newton.phys>
+ Branch: cfgperl
+ ! Configure config_h.SH hints/sunos_4_1.sh util.c
+____________________________________________________________________________
+[ 3487] By: gsar on 1999/05/27 03:56:20
+ Log: make win32_spawnvp() inherit standard handles even when they
+ may be redirected
+ Branch: perl
+ ! win32/win32.c
+____________________________________________________________________________
+[ 3486] By: jhi on 1999/05/26 19:55:52
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ To: perl5-porters@perl.org
+ Subject: Re: BUG -> [19990526.004] perl5.005_57 error in util.c on sun4-solaris2.6
+ Date: Wed, 26 May 1999 14:49:52 -0400 (EDT)
+ Message-Id: <Pine.GSU.4.05.9905261448310.19172-100000@newton.phys>
+ Branch: cfgperl
+ ! util.c
+____________________________________________________________________________
+[ 3485] By: chip on 1999/05/26 17:19:11
+ Log: Look for Linux FILE structure in libio.h, for glibc-2.1.
+ Branch: maint-5.004/perl
+ ! Configure
+____________________________________________________________________________
+[ 3484] By: gsar on 1999/05/26 01:56:28
+ Log: fix missing exported symbol
+ Branch: perl
+ ! malloc.c win32/makedef.pl
+____________________________________________________________________________
+[ 3483] By: jhi on 1999/05/25 23:08:07
+ Log: Configure -Dopenbsd_distribution to build for the OpenBSD tree.
+
+ From: "Todd C. Miller" <Todd.Miller@courtesan.com>
+ To: perlbug@perl.com
+ Subject: OpenBSD hints file update
+ Date: Tue, 25 May 1999 12:12:38 -0600 (MDT)
+ Message-Id: <199905251812.MAA06032@xerxes.courtesan.com>
+ Branch: cfgperl
+ ! hints/openbsd.sh
+____________________________________________________________________________
+[ 3482] By: jhi on 1999/05/25 23:01:25
+ Log: From: Tom Hughes <tom@compton.nu>
+ To: perl5-porters@perl.org
+ Subject: [PATCH 5.005_57] Make Configure recognise glibc 2.1 stdio
+ Date: Tue, 25 May 1999 23:10:23 +0100
+ Message-ID: <1ed7f10749.tom@compton.compton.nu>
+ Branch: cfgperl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 3481] By: jhi on 1999/05/25 22:31:50
+ Log: 3479, 3480, 3481 seems logical.
+ Branch: cfgperl
+ !> hints/aix.sh
+____________________________________________________________________________
+[ 3480] By: jhi on 1999/05/25 22:13:39
+ Log: The change #3479 wasn't perfect.
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 3479] By: jhi on 1999/05/25 21:59:21
+ Log: Cures for _57 in AIX 4.1.5.0.
+ (1) The lddlflags lost its -lc by change #3660
+ (and the politeness of change #3257).
+ (2) optype_size must end up in perl.exp (as PL_optype_size).
+ Added it to perlvars.h, fixed bytecode.pl,
+ regen'ed the relevant headers.
+ Branch: cfgperl
+ ! bytecode.h bytecode.pl byterun.h embed.h embedvar.h objXSUB.h
+ ! perlvars.h
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 3478] By: jhi on 1999/05/25 20:13:47
+ Log: Integrate from mainperl.
+ Branch: cfgperl
+ +> pod/perltootc.pod
+ !> (integrate 101 files)
+____________________________________________________________________________
+[ 3477] By: gsar on 1999/05/25 10:43:48
+ Log: here be 5.005_57
+ Branch: perl
+ ! Changes MANIFEST Porting/makerel
+ !> Changes5.005
+
+----------------
+Version 5.005_57
----------------
____________________________________________________________________________
diff --git a/Configure b/Configure
index 83e41da710..1fca209354 100755
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Sat May 22 00:54:37 EET DST 1999 [metaconfig 3.0 PL70]
+# Generated on Sun May 30 15:51:19 EET DST 1999 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.com)
cat >/tmp/c1$$ <<EOF
@@ -338,6 +338,7 @@ d_endnent=''
d_endpent=''
d_endpwent=''
d_endsent=''
+d_endspent=''
d_fchmod=''
d_fchown=''
d_fcntl=''
@@ -383,6 +384,8 @@ d_getprotoprotos=''
d_getpwent=''
d_getsent=''
d_getservprotos=''
+d_getspent=''
+d_getspnam=''
d_getsbyname=''
d_getsbyport=''
d_gnulibc=''
@@ -474,6 +477,7 @@ d_setrgid=''
d_setruid=''
d_setsent=''
d_setsid=''
+d_setspent=''
d_setvbuf=''
d_sfio=''
usesfio=''
@@ -623,6 +627,7 @@ d_pwpasswd=''
d_pwquota=''
i_pwd=''
i_sfio=''
+i_shadow=''
i_stddef=''
i_stdlib=''
i_string=''
@@ -950,7 +955,7 @@ useopcode=true
: If anyone needs -lnet, put it in a hint file.
libswanted='sfio socket inet nsl nm ndbm gdbm dbm db malloc dl'
libswanted="$libswanted dld ld sun m rt c cposix posix"
-libswanted="$libswanted ndir dir crypt"
+libswanted="$libswanted ndir dir crypt sec"
libswanted="$libswanted ucb bsd BSD PW x"
: We probably want to search /usr/shlib before most other libraries.
: This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist.
@@ -2103,7 +2108,7 @@ EOM
osvers=$tmp
elif $test -f /etc/kconfig; then
osname=isc
- if test "$lns" = "ln -s"; then
+ if test "$lns" = "$ln -s"; then
osvers=4
elif $contains _SYSV3 /usr/include/stdio.h > /dev/null 2>&1 ; then
osvers=3
@@ -7566,6 +7571,10 @@ eval $inlibc
set endservent d_endsent
eval $inlibc
+: see if endspent exists
+set endspent d_endspent
+eval $inlibc
+
: Locate the flags for 'open()'
echo " "
$cat >open3.c <<'EOCP'
@@ -8267,6 +8276,14 @@ echo " "
set d_getservprotos getservent $i_netdb netdb.h
eval $hasproto
+: see if getspent exists
+set getspent d_getspent
+eval $inlibc
+
+: see if getspnam exists
+set getspnam d_getspnam
+eval $inlibc
+
: see if gettimeofday or ftime exists
set gettimeofday d_gettimeod
eval $inlibc
@@ -9619,6 +9636,10 @@ eval $inlibc
set setsid d_setsid
eval $inlibc
+: see if setspent exists
+set setspent d_setspent
+eval $inlibc
+
: see if setvbuf exists
set setvbuf d_setvbuf
eval $inlibc
@@ -9836,7 +9857,7 @@ eval $hasfield
: see if _ptr and _cnt from stdio act std
echo " "
-if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then
+if $contains '_IO_fpos_t' `./findhdr stdio.h` `./findhdr libio.h` >/dev/null 2>&1 ; then
echo "(Looks like you have stdio.h from Linux.)"
case "$stdio_ptr" in
'') stdio_ptr='((fp)->_IO_read_ptr)'
@@ -10962,18 +10983,17 @@ $rm -f tebcdic.c tebcdic
set ebcdic
eval $setvar
-# SunOS has a <unistd.h> which we generally avoid, but need for this test.
-# For everyone else, we'll trust i_unistd.
-t_unistd=$i_unistd
-case "$osname" in
-sunos) $test -f /usr/include/unistd.h && t_unistd=$define ;;
-esac
$cat >&4 <<EOM
Checking how to flush all pending stdio output...
EOM
-$cat >try.c <<EOCP
+# 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>
-#$t_unistd I_UNISTD
+#$i_unistd I_UNISTD
#ifdef I_UNISTD
# include <unistd.h>
#endif
@@ -10997,26 +11017,33 @@ int main() {
#ifdef TRY_FFLUSH_ALL
{
long open_max = -1;
-# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
- open_max = sysconf(_SC_OPEN_MAX);
+# ifdef PERL_FFLUSH_ALL_FOPEN_MAX
+ open_max = PERL_FFLUSH_ALL_FOPEN_MAX;
# else
-# ifdef FOPEN_MAX
-# open_max = FOPEN_MAX;
+# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
+ open_max = sysconf(_SC_OPEN_MAX);
# else
-# ifdef OPEN_MAX
-# open_max = OPEN_MAX;
+# ifdef FOPEN_MAX
+ open_max = FOPEN_MAX;
# else
-# ifdef _NFILE
-# open_max = _NFILE;
+# ifdef OPEN_MAX
+ open_max = OPEN_MAX;
+# else
+# ifdef _NFILE
+ open_max = _NFILE;
+# endif
# endif
# endif
# endif
-# endif
+# endif
# ifdef HAS_STDIO_STREAM_ARRAY
if (open_max > 0) {
long i;
for (i = 0; i < open_max; i++)
- fflush(&$stdio_stream_array[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
@@ -11028,8 +11055,8 @@ EOCP
if $test "X$fflushNULL" = X -o "X$fflushall" = X; then
output=''
set try -DTRY_FPUTC
- $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_FPUTC
@@ -11040,6 +11067,7 @@ if $test "X$fflushNULL" = X -o "X$fflushall" = X; then
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
@@ -11051,8 +11079,8 @@ fi
: check for fflush NULL behaviour
case "$fflushNULL" in
'') set try -DTRY_FFLUSH_NULL $output
- $rm -f try.out
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
@@ -11098,11 +11126,11 @@ case "$fflushNULL" in
: check for fflush all behaviour
case "$fflushall" in
'') set try -DTRY_FFLUSH_ALL $output
- $rm -f try.out
if eval $compile; then
- $cat >&4 <<EOM
+ $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`"
@@ -11626,6 +11654,10 @@ EOM
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
+#$d_socket HAS_SOCKET
+#ifdef HAS_SOCKET
+# include <sys/socket.h> /* Might include <sys/bsdtypes.h> */
+#endif
#include <stdio.h>
$selecttype b;
#define S sizeof(*(b))
@@ -12381,6 +12413,10 @@ set i_termio; eval $setvar
val=$val2; set i_sgtty; eval $setvar
val=$val3; set i_termios; eval $setvar
+: see if this is a shadow.h system
+set shadow.h i_shadow
+eval $inhdr
+
: see if stdarg is available
echo " "
if $test `./findhdr stdarg.h`; then
@@ -12973,6 +13009,7 @@ d_endnent='$d_endnent'
d_endpent='$d_endpent'
d_endpwent='$d_endpwent'
d_endsent='$d_endsent'
+d_endspent='$d_endspent'
d_eofnblk='$d_eofnblk'
d_eunice='$d_eunice'
d_fchmod='$d_fchmod'
@@ -13032,6 +13069,8 @@ d_getsbyname='$d_getsbyname'
d_getsbyport='$d_getsbyport'
d_getsent='$d_getsent'
d_getservprotos='$d_getservprotos'
+d_getspent='$d_getspent'
+d_getspnam='$d_getspnam'
d_gettimeod='$d_gettimeod'
d_gnulibc='$d_gnulibc'
d_grpasswd='$d_grpasswd'
@@ -13153,6 +13192,7 @@ d_setrgid='$d_setrgid'
d_setruid='$d_setruid'
d_setsent='$d_setsent'
d_setsid='$d_setsid'
+d_setspent='$d_setspent'
d_setvbuf='$d_setvbuf'
d_sfio='$d_sfio'
d_shm='$d_shm'
@@ -13289,6 +13329,7 @@ i_pwd='$i_pwd'
i_rpcsvcdbm='$i_rpcsvcdbm'
i_sfio='$i_sfio'
i_sgtty='$i_sgtty'
+i_shadow='$i_shadow'
i_stdarg='$i_stdarg'
i_stddef='$i_stddef'
i_stdlib='$i_stdlib'
diff --git a/MANIFEST b/MANIFEST
index 52c0e71d2b..aaf7f11c6a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -60,10 +60,7 @@ apollo/netinet/in.h Apollo DomainOS port: C header file frontend
av.c Array value code
av.h Array value header
beos/nm.c BeOS port
-bytecode.h Bytecode header for compiler
-bytecode.pl Produces byterun.h, byterun.c and ext/B/Asmdata.pm
-byterun.c Runtime support for compiler-generated bytecode
-byterun.h Header for byterun.c
+bytecode.pl Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c and ext/B/Asmdata.pm
cc_runtime.h Macros need by runtime of compiler-generated code
cflags.SH A script that emits C compilation flags per file
config_h.SH Produces config.h
@@ -189,7 +186,6 @@ ext/B/O.pm Compiler front-end module (-MO=...)
ext/B/README Compiler backend README
ext/B/TESTS Compiler backend test data
ext/B/Todo Compiler backend Todo list
-ext/B/byteperl.c Bytecode runner
ext/B/defsubs.h.PL Generator for constant subroutines
ext/B/ramblings/cc.notes Compiler ramblings: notes on CC backend
ext/B/ramblings/curcop.runtime Compiler ramblings: notes on curcop use
@@ -201,6 +197,9 @@ ext/B/typemap Compiler backend interface types
ext/ByteLoader/ByteLoader.pm Bytecode loader Perl module
ext/ByteLoader/ByteLoader.xs Bytecode loader external subroutines
ext/ByteLoader/Makefile.PL Bytecode loader makefile writer
+ext/ByteLoader/bytecode.h Bytecode header for bytecode loader
+ext/ByteLoader/byterun.c Runtime support for bytecode loader
+ext/ByteLoader/byterun.h Header for byterun.c
ext/DB_File/Changes Berkeley DB extension change log
ext/DB_File/DB_File.pm Berkeley DB extension Perl module
ext/DB_File/DB_File.xs Berkeley DB extension external subroutines
@@ -907,7 +906,6 @@ os2/OS2/REXX/t/rx_tievar.t DLL access module
os2/OS2/REXX/t/rx_tieydb.t DLL access module
os2/OS2/REXX/t/rx_varset.t DLL access module
os2/OS2/REXX/t/rx_vrexx.t DLL access module
-os2/POSIX.mkfifo POSIX.xs patch
os2/diff.configure Patches to Configure
os2/dl_os2.c Addon for dl_open
os2/dlfcn.h Addon for dl_open
@@ -1326,7 +1324,6 @@ utils/c2ph.PL program to translate dbx stabs to perl
utils/h2ph.PL A thing to turn C .h files into perl .ph files
utils/h2xs.PL Program to make .xs files from C header files
utils/perlbug.PL A simple tool to submit a bug report
-utils/perlbc.PL Front-end for bytecode compiler
utils/perlcc.PL Front-end for compiler
utils/perldoc.PL A simple tool to find & display perl's documentation
utils/pl2pm.PL A pl to pm translator
diff --git a/Makefile.SH b/Makefile.SH
index aa0e3f278e..0c02a43838 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -224,16 +224,16 @@ h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
-h5 = bytecode.h byterun.h utf8.h warning.h
+h5 = utf8.h warning.h
h = $(h1) $(h2) $(h3) $(h4) $(h5)
-c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c
+c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c
c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c globals.c perlio.c
c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c
-obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) byterun$(OBJ_EXT)
+obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT)
obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT)
@@ -485,9 +485,9 @@ SYMH = perlvars.h intrpvar.h thrdvar.h
# pp.sym: opcode.pl
# embed.h: embed.pl [* needs pp.sym generated by opcode.pl! *]
# embedvar.h: embed.pl [* needs pp.sym generated by opcode.pl! *]
-# byterun.h: bytecode.pl
-# byterun.c: bytecode.pl
-# lib/B/Asmdata.pm: bytecode.pl
+# ext/ByteLoader/byterun.h: bytecode.pl
+# ext/ByteLoader/byterun.c: bytecode.pl
+# ext/B/Asmdata.pm: bytecode.pl
# regnodes.h: regcomp.pl
# warning.h lib/warning.pm: warning.pl
# The correct versions should be already supplied with the perl kit,
@@ -605,7 +605,9 @@ depend: makedepend
makedepend: makedepend.SH config.sh
sh ./makedepend.SH
-test-prep: miniperl perl preplibrary utilities $(dynamic_ext) $(nonxs_ext)
+# Cannot delegate rebuilding of t/perl to make to allow interlaced
+# test and minitest
+test-prep: miniperl perl preplibrary utilities $(dynamic_ext) $(nonxs_ext) $(TEST_PERL_DLL)
cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT))
# Second branch is for testing without a tty or controling terminal.
@@ -672,11 +674,18 @@ elc: emacs/cperl-mode.elc
emacs/cperl-mode.elc: emacs/cperl-mode.el
-cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el
-etags: emacs/cperl-mode.elc
+etags: TAGS
+
+TAGS: emacs/cperl-mode.elc
sh emacs/ptags
- perl emacs/e2ctags.pl TAGS > tags
-ctags: etags
+ctags: tags
+
+# Let's hope make will not go into an infinite loop on case-unsensitive systems
+# This may also fail if . is in the head of the path, since perl will
+# require -Ilib
+tags: TAGS
+ perl emacs/e2ctags.pl TAGS > tags
# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
# If this runs make out of memory, delete /usr/include lines.
diff --git a/bytecode.pl b/bytecode.pl
index f53b0cef4b..93457eaaed 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -36,7 +36,7 @@ EOT
my $perl_header;
($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
-unlink "byterun.c", "byterun.h", "ext/B/B/Asmdata.pm";
+unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm";
#
# Start with boilerplate for Asmdata.pm
@@ -62,34 +62,59 @@ EOT
#
# Boilerplate for byterun.c
#
-open(BYTERUN_C, ">byterun.c") or die "byterun.c: $!";
+open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!";
print BYTERUN_C $c_header, <<'EOT';
#include "EXTERN.h"
#include "perl.h"
+#include "byterun.h"
+#include "bytecode.h"
+
+static int optype_size[] = {
+EOT
+my $i = 0;
+for ($i = 0; $i < @optype - 1; $i++) {
+ printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i;
+}
+printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i;
+print BYTERUN_C <<'EOT';
+};
+
+static SV *specialsv_list[4];
+
+static int bytecode_iv_overflows = 0;
+static SV *bytecode_sv;
+static XPV bytecode_pv;
+static void **bytecode_obj_list;
+static I32 bytecode_obj_list_fill = -1;
void *
bset_obj_store(void *obj, I32 ix)
{
- if (ix > PL_bytecode_obj_list_fill) {
- if (PL_bytecode_obj_list_fill == -1)
- New(666, PL_bytecode_obj_list, ix + 1, void*);
+ if (ix > bytecode_obj_list_fill) {
+ if (bytecode_obj_list_fill == -1)
+ New(666, bytecode_obj_list, ix + 1, void*);
else
- Renew(PL_bytecode_obj_list, ix + 1, void*);
- PL_bytecode_obj_list_fill = ix;
+ Renew(bytecode_obj_list, ix + 1, void*);
+ bytecode_obj_list_fill = ix;
}
- PL_bytecode_obj_list[ix] = obj;
+ bytecode_obj_list[ix] = obj;
return obj;
}
-#ifdef INDIRECT_BGET_MACROS
void byterun(struct bytestream bs)
-#else
-void byterun(PerlIO *fp)
-#endif /* INDIRECT_BGET_MACROS */
{
dTHR;
int insn;
+
+EOT
+
+for (my $i = 0; $i < @specialsv; $i++) {
+ print BYTERUN_C " specialsv_list[$i] = $specialsv[$i];\n";
+}
+
+print BYTERUN_C <<'EOT';
+
while ((insn = BGET_FGETC()) != EOF) {
switch (insn) {
EOT
@@ -124,7 +149,7 @@ while (<DATA>) {
if ($flags =~ /x/) {
print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
} elsif ($flags =~ /s/) {
- # Store instructions store to PL_bytecode_obj_list[arg]. "lvalue" field is rvalue.
+ # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
}
elsif ($optarg && $lvalue ne "none") {
@@ -158,16 +183,14 @@ EOT
#
# Write the instruction and optype enum constants into byterun.h
#
-open(BYTERUN_H, ">byterun.h") or die "byterun.h: $!";
+open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
print BYTERUN_H $c_header, <<'EOT';
-#ifdef INDIRECT_BGET_MACROS
struct bytestream {
void *data;
int (*fgetc)(void *);
- int (*fread)(char *, size_t, size_t, void*);
- void (*freadpv)(U32, void*);
+ int (*fread)(char *, size_t, size_t, void *);
+ void (*freadpv)(U32, void *, XPV *);
};
-#endif /* INDIRECT_BGET_MACROS */
enum {
EOT
@@ -198,7 +221,7 @@ for ($i = 0; $i < @optype - 1; $i++) {
}
printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
print BYTERUN_H <<'EOT';
-EXT int optype_size[]
+EXT int PL_optype_size[]
#ifdef DOINIT
= {
EOT
@@ -271,85 +294,85 @@ nop none none
#opcode lvalue argtype flags
#
ret none none x
-ldsv PL_bytecode_sv svindex
+ldsv bytecode_sv svindex
ldop PL_op opindex
-stsv PL_bytecode_sv U32 s
+stsv bytecode_sv U32 s
stop PL_op U32 s
-ldspecsv PL_bytecode_sv U8 x
-newsv PL_bytecode_sv U8 x
+ldspecsv bytecode_sv U8 x
+newsv bytecode_sv U8 x
newop PL_op U8 x
newopn PL_op U8 x
newpv none PV
-pv_cur PL_bytecode_pv.xpv_cur STRLEN
-pv_free PL_bytecode_pv none x
-sv_upgrade PL_bytecode_sv char x
-sv_refcnt SvREFCNT(PL_bytecode_sv) U32
-sv_refcnt_add SvREFCNT(PL_bytecode_sv) I32 x
-sv_flags SvFLAGS(PL_bytecode_sv) U32
-xrv SvRV(PL_bytecode_sv) svindex
-xpv PL_bytecode_sv none x
-xiv32 SvIVX(PL_bytecode_sv) I32
-xiv64 SvIVX(PL_bytecode_sv) IV64
-xnv SvNVX(PL_bytecode_sv) double
-xlv_targoff LvTARGOFF(PL_bytecode_sv) STRLEN
-xlv_targlen LvTARGLEN(PL_bytecode_sv) STRLEN
-xlv_targ LvTARG(PL_bytecode_sv) svindex
-xlv_type LvTYPE(PL_bytecode_sv) char
-xbm_useful BmUSEFUL(PL_bytecode_sv) I32
-xbm_previous BmPREVIOUS(PL_bytecode_sv) U16
-xbm_rare BmRARE(PL_bytecode_sv) U8
-xfm_lines FmLINES(PL_bytecode_sv) I32
-xio_lines IoLINES(PL_bytecode_sv) long
-xio_page IoPAGE(PL_bytecode_sv) long
-xio_page_len IoPAGE_LEN(PL_bytecode_sv) long
-xio_lines_left IoLINES_LEFT(PL_bytecode_sv) long
-xio_top_name IoTOP_NAME(PL_bytecode_sv) pvcontents
-xio_top_gv *(SV**)&IoTOP_GV(PL_bytecode_sv) svindex
-xio_fmt_name IoFMT_NAME(PL_bytecode_sv) pvcontents
-xio_fmt_gv *(SV**)&IoFMT_GV(PL_bytecode_sv) svindex
-xio_bottom_name IoBOTTOM_NAME(PL_bytecode_sv) pvcontents
-xio_bottom_gv *(SV**)&IoBOTTOM_GV(PL_bytecode_sv) svindex
-xio_subprocess IoSUBPROCESS(PL_bytecode_sv) short
-xio_type IoTYPE(PL_bytecode_sv) char
-xio_flags IoFLAGS(PL_bytecode_sv) char
-xcv_stash *(SV**)&CvSTASH(PL_bytecode_sv) svindex
-xcv_start CvSTART(PL_bytecode_sv) opindex
-xcv_root CvROOT(PL_bytecode_sv) opindex
-xcv_gv *(SV**)&CvGV(PL_bytecode_sv) svindex
-xcv_filegv *(SV**)&CvFILEGV(PL_bytecode_sv) svindex
-xcv_depth CvDEPTH(PL_bytecode_sv) long
-xcv_padlist *(SV**)&CvPADLIST(PL_bytecode_sv) svindex
-xcv_outside *(SV**)&CvOUTSIDE(PL_bytecode_sv) svindex
-xcv_flags CvFLAGS(PL_bytecode_sv) U8
-av_extend PL_bytecode_sv SSize_t x
-av_push PL_bytecode_sv svindex x
-xav_fill AvFILLp(PL_bytecode_sv) SSize_t
-xav_max AvMAX(PL_bytecode_sv) SSize_t
-xav_flags AvFLAGS(PL_bytecode_sv) U8
-xhv_riter HvRITER(PL_bytecode_sv) I32
-xhv_name HvNAME(PL_bytecode_sv) pvcontents
-hv_store PL_bytecode_sv svindex x
-sv_magic PL_bytecode_sv char x
-mg_obj SvMAGIC(PL_bytecode_sv)->mg_obj svindex
-mg_private SvMAGIC(PL_bytecode_sv)->mg_private U16
-mg_flags SvMAGIC(PL_bytecode_sv)->mg_flags U8
-mg_pv SvMAGIC(PL_bytecode_sv) pvcontents x
-xmg_stash *(SV**)&SvSTASH(PL_bytecode_sv) svindex
-gv_fetchpv PL_bytecode_sv strconst x
-gv_stashpv PL_bytecode_sv strconst x
-gp_sv GvSV(PL_bytecode_sv) svindex
-gp_refcnt GvREFCNT(PL_bytecode_sv) U32
-gp_refcnt_add GvREFCNT(PL_bytecode_sv) I32 x
-gp_av *(SV**)&GvAV(PL_bytecode_sv) svindex
-gp_hv *(SV**)&GvHV(PL_bytecode_sv) svindex
-gp_cv *(SV**)&GvCV(PL_bytecode_sv) svindex
-gp_filegv *(SV**)&GvFILEGV(PL_bytecode_sv) svindex
-gp_io *(SV**)&GvIOp(PL_bytecode_sv) svindex
-gp_form *(SV**)&GvFORM(PL_bytecode_sv) svindex
-gp_cvgen GvCVGEN(PL_bytecode_sv) U32
-gp_line GvLINE(PL_bytecode_sv) line_t
-gp_share PL_bytecode_sv svindex x
-xgv_flags GvFLAGS(PL_bytecode_sv) U8
+pv_cur bytecode_pv.xpv_cur STRLEN
+pv_free bytecode_pv none x
+sv_upgrade bytecode_sv char x
+sv_refcnt SvREFCNT(bytecode_sv) U32
+sv_refcnt_add SvREFCNT(bytecode_sv) I32 x
+sv_flags SvFLAGS(bytecode_sv) U32
+xrv SvRV(bytecode_sv) svindex
+xpv bytecode_sv none x
+xiv32 SvIVX(bytecode_sv) I32
+xiv64 SvIVX(bytecode_sv) IV64
+xnv SvNVX(bytecode_sv) double
+xlv_targoff LvTARGOFF(bytecode_sv) STRLEN
+xlv_targlen LvTARGLEN(bytecode_sv) STRLEN
+xlv_targ LvTARG(bytecode_sv) svindex
+xlv_type LvTYPE(bytecode_sv) char
+xbm_useful BmUSEFUL(bytecode_sv) I32
+xbm_previous BmPREVIOUS(bytecode_sv) U16
+xbm_rare BmRARE(bytecode_sv) U8
+xfm_lines FmLINES(bytecode_sv) I32
+xio_lines IoLINES(bytecode_sv) long
+xio_page IoPAGE(bytecode_sv) long
+xio_page_len IoPAGE_LEN(bytecode_sv) long
+xio_lines_left IoLINES_LEFT(bytecode_sv) long
+xio_top_name IoTOP_NAME(bytecode_sv) pvcontents
+xio_top_gv *(SV**)&IoTOP_GV(bytecode_sv) svindex
+xio_fmt_name IoFMT_NAME(bytecode_sv) pvcontents
+xio_fmt_gv *(SV**)&IoFMT_GV(bytecode_sv) svindex
+xio_bottom_name IoBOTTOM_NAME(bytecode_sv) pvcontents
+xio_bottom_gv *(SV**)&IoBOTTOM_GV(bytecode_sv) svindex
+xio_subprocess IoSUBPROCESS(bytecode_sv) short
+xio_type IoTYPE(bytecode_sv) char
+xio_flags IoFLAGS(bytecode_sv) char
+xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex
+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_depth CvDEPTH(bytecode_sv) long
+xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex
+xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex
+xcv_flags CvFLAGS(bytecode_sv) U8
+av_extend bytecode_sv SSize_t x
+av_push bytecode_sv svindex x
+xav_fill AvFILLp(bytecode_sv) SSize_t
+xav_max AvMAX(bytecode_sv) SSize_t
+xav_flags AvFLAGS(bytecode_sv) U8
+xhv_riter HvRITER(bytecode_sv) I32
+xhv_name HvNAME(bytecode_sv) pvcontents
+hv_store bytecode_sv svindex x
+sv_magic bytecode_sv char x
+mg_obj SvMAGIC(bytecode_sv)->mg_obj svindex
+mg_private SvMAGIC(bytecode_sv)->mg_private U16
+mg_flags SvMAGIC(bytecode_sv)->mg_flags U8
+mg_pv SvMAGIC(bytecode_sv) pvcontents x
+xmg_stash *(SV**)&SvSTASH(bytecode_sv) svindex
+gv_fetchpv bytecode_sv strconst x
+gv_stashpv bytecode_sv strconst x
+gp_sv GvSV(bytecode_sv) svindex
+gp_refcnt GvREFCNT(bytecode_sv) U32
+gp_refcnt_add GvREFCNT(bytecode_sv) I32 x
+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_io *(SV**)&GvIOp(bytecode_sv) svindex
+gp_form *(SV**)&GvFORM(bytecode_sv) svindex
+gp_cvgen GvCVGEN(bytecode_sv) U32
+gp_line GvLINE(bytecode_sv) line_t
+gp_share bytecode_sv svindex x
+xgv_flags GvFLAGS(bytecode_sv) U8
op_next PL_op->op_next opindex
op_sibling PL_op->op_sibling opindex
op_ppaddr PL_op->op_ppaddr strconst x
diff --git a/cc_runtime.h b/cc_runtime.h
index 5b6d2c7287..bb9b7dc5d9 100644
--- a/cc_runtime.h
+++ b/cc_runtime.h
@@ -59,39 +59,16 @@
SPAGAIN; \
} while (0)
-#define B_JMPENV_PUSH(cur_env,v) \
- STMT_START { \
- cur_env.je_prev = PL_top_env; \
- OP_REG_TO_MEM; \
- cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1); \
- OP_MEM_TO_REG; \
- PL_top_env = &cur_env; \
- cur_env.je_mustcatch = FALSE; \
- (v) = cur_env.je_ret; \
- } STMT_END
-#define B_JMPENV_POP(cur_env) \
- STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
-#define B_JMPENV_JUMP(cur_env,v) \
- STMT_START { \
- OP_REG_TO_MEM; \
- if (PL_top_env->je_prev) \
- PerlProc_longjmp(PL_top_env->je_buf, (v)); \
- if ((v) == 2) \
- PerlProc_exit(STATUS_NATIVE_EXPORT); \
- PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \
- PerlProc_exit(1); \
- } STMT_END
-
-
-#define PP_ENTERTRY(jmpbuf,label) { \
- int ret; \
- B_JMPENV_PUSH(jmpbuf,ret); \
- switch (ret) { \
- case 1: B_JMPENV_POP(jmpbuf); B_JMPENV_JUMP(jmpbuf,1); \
- case 2: B_JMPENV_POP(jmpbuf); B_JMPENV_JUMP(jmpbuf,2); \
- case 3: B_JMPENV_POP(jmpbuf); SPAGAIN; goto label;\
- } \
- } while (0)
-
-#define PP_LEAVETRY PL_top_env=PL_top_env->je_prev
+#define PP_ENTERTRY(jmpbuf,label) \
+ STMT_START { \
+ int ret; \
+ JMPENV_PUSH_ENV(jmpbuf,ret); \
+ switch (ret) { \
+ case 1: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(1);\
+ case 2: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(2);\
+ case 3: JMPENV_POP_ENV(jmpbuf); SPAGAIN; goto label;\
+ } \
+ } STMT_END
+#define PP_LEAVETRY \
+ STMT_START{ PL_top_env=PL_top_env->je_prev; }STMT_END
diff --git a/config_h.SH b/config_h.SH
index 97f084e35c..44d4379851 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -2094,6 +2094,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/
+/* HAS_ENDSPENT:
+ * This symbol, if defined, indicates that the endspent system call is
+ * available to finalize the scan of SysV shadow password entries.
+ */
+#$d_endspent HAS_ENDSPENT /**/
+
/* HAS_FSEEKO:
* This symbol, if defined, indicates that the fseeko routine is
* available to fseek beyond 32 bits (useful for ILP32 hosts).
@@ -2112,6 +2118,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_getmntent HAS_GETMNTENT /**/
+/* HAS_GETSPENT:
+ * This symbol, if defined, indicates that the getspent system call is
+ * available to retrieve SysV shadow password entries sequentially.
+ */
+#$d_getspent HAS_GETSPENT /**/
+
+/* HAS_GETSPNAM:
+ * This symbol, if defined, indicates that the getspnam system call is
+ * available to retrieve SysV shadow password entries by name.
+ */
+#$d_getspnam HAS_GETSPNAM /**/
+
/* HAS_HASMNTOPT:
* This symbol, if defined, indicates that the hasmntopt routine is
* available to query the mount options of file systems.
@@ -2137,6 +2155,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$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_setspent HAS_SETSPENT /**/
+
/* USE_SFIO:
* This symbol, if defined, indicates that sfio should
* be used.
@@ -2276,6 +2300,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_poll I_POLL /**/
+/* I_SHADOW:
+ * This symbol, if defined, indicates that <shadow.h> exists and
+ * should be included.
+ */
+#$i_shadow I_SHADOW /**/
+
/* I_SYS_MMAN:
* This symbol, if defined, indicates that <sys/mman.h> exists and
* should be included.
diff --git a/embed.h b/embed.h
index aa9db44716..7542fe60a3 100644
--- a/embed.h
+++ b/embed.h
@@ -42,7 +42,6 @@
#define block_start Perl_block_start
#define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL
#define bset_obj_store Perl_bset_obj_store
-#define byterun Perl_byterun
#define call_list Perl_call_list
#define cando Perl_cando
#define cast_i32 Perl_cast_i32
@@ -163,7 +162,6 @@
#define get_op_descs Perl_get_op_descs
#define get_op_names Perl_get_op_names
#define get_opargs Perl_get_opargs
-#define get_specialsv_list Perl_get_specialsv_list
#define get_vtbl Perl_get_vtbl
#define gp_free Perl_gp_free
#define gp_ref Perl_gp_ref
@@ -1010,7 +1008,6 @@
#define block_start CPerlObj::Perl_block_start
#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL
#define bset_obj_store CPerlObj::Perl_bset_obj_store
-#define byterun CPerlObj::Perl_byterun
#define cache_re CPerlObj::Perl_cache_re
#define call_list CPerlObj::Perl_call_list
#define call_list_body CPerlObj::Perl_call_list_body
@@ -1187,7 +1184,6 @@
#define get_op_descs CPerlObj::Perl_get_op_descs
#define get_op_names CPerlObj::Perl_get_op_names
#define get_opargs CPerlObj::Perl_get_opargs
-#define get_specialsv_list CPerlObj::Perl_get_specialsv_list
#define get_vtbl CPerlObj::Perl_get_vtbl
#define gp_free CPerlObj::Perl_gp_free
#define gp_ref CPerlObj::Perl_gp_ref
diff --git a/embedvar.h b/embedvar.h
index 73c674caf2..f9bd01166c 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -154,11 +154,6 @@
#define PL_argvoutgv (PL_curinterp->Iargvoutgv)
#define PL_basetime (PL_curinterp->Ibasetime)
#define PL_beginav (PL_curinterp->Ibeginav)
-#define PL_bytecode_iv_overflows (PL_curinterp->Ibytecode_iv_overflows)
-#define PL_bytecode_obj_list (PL_curinterp->Ibytecode_obj_list)
-#define PL_bytecode_obj_list_fill (PL_curinterp->Ibytecode_obj_list_fill)
-#define PL_bytecode_pv (PL_curinterp->Ibytecode_pv)
-#define PL_bytecode_sv (PL_curinterp->Ibytecode_sv)
#define PL_cddir (PL_curinterp->Icddir)
#define PL_compcv (PL_curinterp->Icompcv)
#define PL_compiling (PL_curinterp->Icompiling)
@@ -287,11 +282,6 @@
#define PL_Iargvoutgv PL_argvoutgv
#define PL_Ibasetime PL_basetime
#define PL_Ibeginav PL_beginav
-#define PL_Ibytecode_iv_overflows PL_bytecode_iv_overflows
-#define PL_Ibytecode_obj_list PL_bytecode_obj_list
-#define PL_Ibytecode_obj_list_fill PL_bytecode_obj_list_fill
-#define PL_Ibytecode_pv PL_bytecode_pv
-#define PL_Ibytecode_sv PL_bytecode_sv
#define PL_Icddir PL_cddir
#define PL_Icompcv PL_compcv
#define PL_Icompiling PL_compiling
@@ -768,7 +758,6 @@
#define PL_runops (PL_Vars.Grunops)
#define PL_sh_path (PL_Vars.Gsh_path)
#define PL_sighandlerp (PL_Vars.Gsighandlerp)
-#define PL_specialsv_list (PL_Vars.Gspecialsv_list)
#define PL_srand_called (PL_Vars.Gsrand_called)
#define PL_subline (PL_Vars.Gsubline)
#define PL_subname (PL_Vars.Gsubname)
@@ -907,7 +896,6 @@
#define PL_Grunops PL_runops
#define PL_Gsh_path PL_sh_path
#define PL_Gsighandlerp PL_sighandlerp
-#define PL_Gspecialsv_list PL_specialsv_list
#define PL_Gsrand_called PL_srand_called
#define PL_Gsubline PL_subline
#define PL_Gsubname PL_subname
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 0bfceafd7d..cdbd3b297e 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -9,7 +9,7 @@ package B;
require DynaLoader;
require Exporter;
@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
+@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
walkoptree walkoptree_slow walkoptree_exec walksymtable
@@ -820,11 +820,6 @@ preceding the first "::". This is used to turn "B::UNOP" into
In a perl compiled for threads, this returns a list of the special
per-thread threadsv variables.
-=item byteload_fh(FILEHANDLE)
-
-Load the contents of FILEHANDLE as bytecode. See documentation for
-the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
-
=back
=head1 AUTHOR
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 466091d679..36d61f3a57 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -83,6 +83,8 @@ static char *opclassnames[] = {
static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
+static SV *specialsv_list[4];
+
static opclass
cc_opclass(OP *o)
{
@@ -197,8 +199,8 @@ make_sv_object(SV *arg, SV *sv)
char *type = 0;
IV iv;
- for (iv = 0; iv < sizeof(PL_specialsv_list)/sizeof(SV*); iv++) {
- if (sv == PL_specialsv_list[iv]) {
+ for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
+ if (sv == specialsv_list[iv]) {
type = "B::SPECIAL";
break;
}
@@ -311,74 +313,6 @@ cchar(SV *sv)
return sstr;
}
-#ifdef INDIRECT_BGET_MACROS
-void freadpv(U32 len, void *data)
-{
- New(666, pv.xpv_pv, len, char);
- fread(pv.xpv_pv, 1, len, (FILE*)data);
- pv.xpv_len = len;
- pv.xpv_cur = len - 1;
-}
-
-void byteload_fh(InputStream fp)
-{
- struct bytestream bs;
- bs.data = fp;
- bs.fgetc = (int(*) _((void*)))fgetc;
- bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
- bs.freadpv = freadpv;
- byterun(bs);
-}
-
-static int fgetc_fromstring(void *data)
-{
- char **strp = (char **)data;
- return *(*strp)++;
-}
-
-static int fread_fromstring(char *argp, size_t elemsize, size_t nelem,
- void *data)
-{
- char **strp = (char **)data;
- size_t len = elemsize * nelem;
-
- memcpy(argp, *strp, len);
- *strp += len;
- return (int)len;
-}
-
-static void freadpv_fromstring(U32 len, void *data)
-{
- char **strp = (char **)data;
-
- New(666, pv.xpv_pv, len, char);
- memcpy(pv.xpv_pv, *strp, len);
- pv.xpv_len = len;
- pv.xpv_cur = len - 1;
- *strp += len;
-}
-
-void byteload_string(char *str)
-{
- struct bytestream bs;
- bs.data = &str;
- bs.fgetc = fgetc_fromstring;
- bs.fread = fread_fromstring;
- bs.freadpv = freadpv_fromstring;
- byterun(bs);
-}
-#else
-void byteload_fh(InputStream fp)
-{
- byterun(fp);
-}
-
-void byteload_string(char *str)
-{
- croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string");
-}
-#endif /* INDIRECT_BGET_MACROS */
-
void
walkoptree(SV *opsv, char *method)
{
@@ -446,7 +380,10 @@ BOOT:
{
HV *stash = gv_stashpvn("B", 1, TRUE);
AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
- INIT_SPECIALSV_LIST;
+ specialsv_list[0] = Nullsv;
+ specialsv_list[1] = &PL_sv_undef;
+ specialsv_list[2] = &PL_sv_yes;
+ specialsv_list[3] = &PL_sv_no;
#include "defsubs.h"
}
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index 29683b899b..42b91998b0 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -894,13 +894,16 @@ C<main_root> and C<curpad> are omitted.
=head1 EXAMPLES
- perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+ perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
- perl -MO=Bytecode,-S foo.pl > foo.S
- assemble foo.S > foo.plc
- byteperl foo.plc
+ perl -MO=Bytecode,-S foo.pl > foo.S
+ assemble foo.S > foo.plc
- perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+Note that C<assemble> lives in the C<B> subdirectory of your perl
+library directory. The utility called perlcc may also be used to
+help make use of this compiler.
+
+ perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
=head1 BUGS
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index ff3694dacc..9af85c9a62 100644
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -18,7 +18,7 @@ WriteMakefile(
VERSION => "a5",
MAN3PODS => {},
clean => {
- FILES => "perl$e byteperl$e *$o B.c defsubs.h *~"
+ FILES => "perl$e *$o B.c defsubs.h *~"
}
);
@@ -33,22 +33,3 @@ sub postamble {
B$(OBJ_EXT) : defsubs.h
'
}
-
-# Leave out doing byteperl for now. Probably should be built in the
-# core directory or somewhere else rather than here
-#sub top_targets {
-# my $self = shift;
-# my $targets = $self->MM::top_targets();
-# $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
-# return <<"EOT" . $targets;
-
-#
-# byteperl is *not* a standard perl+XSUB executable. It's a special
-# program for running standalone bytecode executables. It isn't an XSUB
-# at the moment because a standlone Perl program needs to set up curpad
-# which is overwritten on exit from an XSUB.
-#
-#byteperl$e : byteperl$o B$o \$(PERL_SRC)/byterun$o
-# \$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS)
-#EOT
-#}
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
index d11d9573c7..46870105d8 100644
--- a/ext/ByteLoader/ByteLoader.pm
+++ b/ext/ByteLoader/ByteLoader.pm
@@ -4,7 +4,7 @@ require DynaLoader;
@ISA = qw(DynaLoader);
-$VERSION = 0.01;
+$VERSION = 0.03;
bootstrap ByteLoader $VERSION;
@@ -19,10 +19,10 @@ ByteLoader - load byte compiled perl code
=head1 SYNOPSIS
- use ByteLoader 0.01;
+ use ByteLoader 0.03;
<byte code>
- use ByteLoader 0.01;
+ use ByteLoader 0.03;
<byte code>
=head1 DESCRIPTION
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 24c3ae8492..ae2e18cd89 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -1,17 +1,16 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include "byterun.h"
-#ifndef WIN32
-/* this is probably not needed manywhere */
-# include "byterun.c"
-#endif
-
-/* defgv must be accessed differently under threaded perl */
-/* DEFSV et al are in 5.004_56 */
-#ifndef DEFSV
-#define DEFSV GvSV(defgv)
-#endif
+static void
+freadpv(U32 len, void *data, XPV *pv)
+{
+ New(666, pv->xpv_pv, len, char);
+ fread(pv->xpv_pv, 1, len, (FILE*)data);
+ pv->xpv_len = len;
+ pv->xpv_cur = len - 1;
+}
static I32
#ifdef PERL_OBJECT
@@ -23,17 +22,14 @@ byteloader_filter(int idx, SV *buf_sv, int maxlen)
dTHR;
OP *saveroot = PL_main_root;
OP *savestart = PL_main_start;
-
-#ifdef INDIRECT_BGET_MACROS
- struct bytesream bs;
+ struct bytestream bs;
bs.data = PL_rsfp;
bs.fgetc = (int(*) _((void*)))fgetc;
bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
bs.freadpv = freadpv;
-#else
- byterun(PL_rsfp);
-#endif
+
+ byterun(bs);
if (PL_in_eval) {
OP *o;
diff --git a/ext/ByteLoader/Makefile.PL b/ext/ByteLoader/Makefile.PL
index 4aabe79683..1facb5a068 100644
--- a/ext/ByteLoader/Makefile.PL
+++ b/ext/ByteLoader/Makefile.PL
@@ -1,10 +1,8 @@
use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
+
WriteMakefile(
- 'NAME' => 'ByteLoader',
- 'VERSION_FROM' => 'ByteLoader.pm', # finds $VERSION
- 'LIBS' => [''], # e.g., '-lm'
- 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
- 'INC' => '-I$(PERL_SRC)', # e.g., '-I/usr/include/other'
+ NAME => 'ByteLoader',
+ VERSION_FROM => 'ByteLoader.pm',
+ XSPROTOARG => '-noprototypes',
+ OBJECT => 'byterun$(OBJ_EXT) ByteLoader$(OBJ_EXT)',
);
diff --git a/bytecode.h b/ext/ByteLoader/bytecode.h
index 9f4f781b8e..abab1e41d8 100644
--- a/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -7,14 +7,9 @@ typedef SV *svindex;
typedef OP *opindex;
typedef IV IV64;
-#ifdef INDIRECT_BGET_MACROS
#define BGET_FREAD(argp, len, nelem) \
bs.fread((char*)(argp),(len),(nelem),bs.data)
#define BGET_FGETC() bs.fgetc(bs.data)
-#else
-#define BGET_FREAD(argp, len, nelem) PerlIO_read(fp, (argp), (len)*(nelem))
-#define BGET_FGETC() PerlIO_getc(fp)
-#endif /* INDIRECT_BGET_MACROS */
#define BGET_U32(arg) \
BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
@@ -24,32 +19,16 @@ typedef IV IV64;
BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg)
#define BGET_U8(arg) arg = BGET_FGETC()
-#if INDIRECT_BGET_MACROS
#define BGET_PV(arg) STMT_START { \
BGET_U32(arg); \
if (arg) \
- bs.freadpv(arg, bs.data); \
+ bs.freadpv(arg, bs.data, &bytecode_pv); \
else { \
- PL_bytecode_pv.xpv_pv = 0; \
- PL_bytecode_pv.xpv_len = 0; \
- PL_bytecode_pv.xpv_cur = 0; \
+ bytecode_pv.xpv_pv = 0; \
+ bytecode_pv.xpv_len = 0; \
+ bytecode_pv.xpv_cur = 0; \
} \
} STMT_END
-#else
-#define BGET_PV(arg) STMT_START { \
- BGET_U32(arg); \
- if (arg) { \
- New(666, PL_bytecode_pv.xpv_pv, arg, char); \
- PerlIO_read(fp, PL_bytecode_pv.xpv_pv, arg); \
- PL_bytecode_pv.xpv_len = arg; \
- PL_bytecode_pv.xpv_cur = arg - 1; \
- } else { \
- PL_bytecode_pv.xpv_pv = 0; \
- PL_bytecode_pv.xpv_len = 0; \
- PL_bytecode_pv.xpv_cur = 0; \
- } \
- } STMT_END
-#endif /* INDIRECT_BGET_MACROS */
#define BGET_comment_t(arg) \
do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
@@ -64,13 +43,13 @@ typedef IV IV64;
BGET_U32(hi); \
BGET_U32(lo); \
if (sizeof(IV) == 8) \
- arg = ((IV)hi << (sizeof(IV)*4) | lo); \
+ arg = (IV) (hi << (sizeof(IV)*4) | lo); \
else if (((I32)hi == -1 && (I32)lo < 0) \
|| ((I32)hi == 0 && (I32)lo >= 0)) { \
arg = (I32)lo; \
} \
else { \
- PL_bytecode_iv_overflows++; \
+ bytecode_iv_overflows++; \
arg = 0; \
} \
} STMT_END
@@ -85,7 +64,7 @@ typedef IV IV64;
arg = (char *) ary; \
} while (0)
-#define BGET_pvcontents(arg) arg = PL_bytecode_pv.xpv_pv
+#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv
#define BGET_strconst(arg) STMT_START { \
for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
arg = PL_tokenbuf; \
@@ -100,12 +79,12 @@ typedef IV IV64;
#define BGET_objindex(arg, type) STMT_START { \
U32 ix; \
BGET_U32(ix); \
- arg = (type)PL_bytecode_obj_list[ix]; \
+ arg = (type)bytecode_obj_list[ix]; \
} STMT_END
#define BGET_svindex(arg) BGET_objindex(arg, svindex)
#define BGET_opindex(arg) BGET_objindex(arg, opindex)
-#define BSET_ldspecsv(sv, arg) sv = PL_specialsv_list[arg]
+#define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg]
#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg
#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg
@@ -117,22 +96,22 @@ typedef IV IV64;
#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE)
#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0)
-#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = PL_bytecode_pv.xpv_cur
+#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur
#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg)
#define BSET_xpv(sv) do { \
- SvPV_set(sv, PL_bytecode_pv.xpv_pv); \
- SvCUR_set(sv, PL_bytecode_pv.xpv_cur); \
- SvLEN_set(sv, PL_bytecode_pv.xpv_len); \
+ SvPV_set(sv, bytecode_pv.xpv_pv); \
+ SvCUR_set(sv, bytecode_pv.xpv_cur); \
+ SvLEN_set(sv, bytecode_pv.xpv_len); \
} while (0)
#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg)
#define BSET_av_push(sv, arg) av_push((AV*)sv, arg)
#define BSET_hv_store(sv, arg) \
- hv_store((HV*)sv, PL_bytecode_pv.xpv_pv, PL_bytecode_pv.xpv_cur, arg, 0)
+ hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0)
#define BSET_pv_free(pv) Safefree(pv.xpv_pv)
#define BSET_pregcomp(o, arg) \
((PMOP*)o)->op_pmregexp = arg ? \
- CALLREGCOMP(arg, arg + PL_bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
+ CALLREGCOMP(arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg)
#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg])
#define BSET_newopn(o, arg) STMT_START { \
@@ -160,5 +139,5 @@ typedef IV IV64;
} STMT_END
#define BSET_OBJ_STORE(obj, ix) \
- (I32)ix > PL_bytecode_obj_list_fill ? \
- bset_obj_store(obj, (I32)ix) : (PL_bytecode_obj_list[ix] = obj)
+ (I32)ix > bytecode_obj_list_fill ? \
+ bset_obj_store(obj, (I32)ix) : (bytecode_obj_list[ix] = obj)
diff --git a/byterun.c b/ext/ByteLoader/byterun.c
index f8c07f9725..ab5b5fc6dc 100644
--- a/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -11,29 +11,56 @@
#include "EXTERN.h"
#include "perl.h"
+#include "byterun.h"
+#include "bytecode.h"
+
+static int optype_size[] = {
+ sizeof(OP),
+ sizeof(UNOP),
+ sizeof(BINOP),
+ sizeof(LOGOP),
+ sizeof(CONDOP),
+ sizeof(LISTOP),
+ sizeof(PMOP),
+ sizeof(SVOP),
+ sizeof(GVOP),
+ sizeof(PVOP),
+ sizeof(LOOP),
+ sizeof(COP)
+};
+
+static SV *specialsv_list[4];
+
+static int bytecode_iv_overflows = 0;
+static SV *bytecode_sv;
+static XPV bytecode_pv;
+static void **bytecode_obj_list;
+static I32 bytecode_obj_list_fill = -1;
void *
bset_obj_store(void *obj, I32 ix)
{
- if (ix > PL_bytecode_obj_list_fill) {
- if (PL_bytecode_obj_list_fill == -1)
- New(666, PL_bytecode_obj_list, ix + 1, void*);
+ if (ix > bytecode_obj_list_fill) {
+ if (bytecode_obj_list_fill == -1)
+ New(666, bytecode_obj_list, ix + 1, void*);
else
- Renew(PL_bytecode_obj_list, ix + 1, void*);
- PL_bytecode_obj_list_fill = ix;
+ Renew(bytecode_obj_list, ix + 1, void*);
+ bytecode_obj_list_fill = ix;
}
- PL_bytecode_obj_list[ix] = obj;
+ bytecode_obj_list[ix] = obj;
return obj;
}
-#ifdef INDIRECT_BGET_MACROS
void byterun(struct bytestream bs)
-#else
-void byterun(PerlIO *fp)
-#endif /* INDIRECT_BGET_MACROS */
{
dTHR;
int insn;
+
+ specialsv_list[0] = Nullsv;
+ specialsv_list[1] = &PL_sv_undef;
+ specialsv_list[2] = &PL_sv_yes;
+ specialsv_list[3] = &PL_sv_no;
+
while ((insn = BGET_FGETC()) != EOF) {
switch (insn) {
case INSN_COMMENT: /* 35 */
@@ -56,7 +83,7 @@ void byterun(PerlIO *fp)
{
svindex arg;
BGET_svindex(arg);
- PL_bytecode_sv = arg;
+ bytecode_sv = arg;
break;
}
case INSN_LDOP: /* 2 */
@@ -70,7 +97,7 @@ void byterun(PerlIO *fp)
{
U32 arg;
BGET_U32(arg);
- BSET_OBJ_STORE(PL_bytecode_sv, arg);
+ BSET_OBJ_STORE(bytecode_sv, arg);
break;
}
case INSN_STOP: /* 4 */
@@ -84,14 +111,14 @@ void byterun(PerlIO *fp)
{
U8 arg;
BGET_U8(arg);
- BSET_ldspecsv(PL_bytecode_sv, arg);
+ BSET_ldspecsv(bytecode_sv, arg);
break;
}
case INSN_NEWSV: /* 6 */
{
U8 arg;
BGET_U8(arg);
- BSET_newsv(PL_bytecode_sv, arg);
+ BSET_newsv(bytecode_sv, arg);
break;
}
case INSN_NEWOP: /* 7 */
@@ -118,486 +145,486 @@ void byterun(PerlIO *fp)
{
STRLEN arg;
BGET_U32(arg);
- PL_bytecode_pv.xpv_cur = arg;
+ bytecode_pv.xpv_cur = arg;
break;
}
case INSN_PV_FREE: /* 12 */
{
- BSET_pv_free(PL_bytecode_pv);
+ BSET_pv_free(bytecode_pv);
break;
}
case INSN_SV_UPGRADE: /* 13 */
{
char arg;
BGET_U8(arg);
- BSET_sv_upgrade(PL_bytecode_sv, arg);
+ BSET_sv_upgrade(bytecode_sv, arg);
break;
}
case INSN_SV_REFCNT: /* 14 */
{
U32 arg;
BGET_U32(arg);
- SvREFCNT(PL_bytecode_sv) = arg;
+ SvREFCNT(bytecode_sv) = arg;
break;
}
case INSN_SV_REFCNT_ADD: /* 15 */
{
I32 arg;
BGET_I32(arg);
- BSET_sv_refcnt_add(SvREFCNT(PL_bytecode_sv), arg);
+ BSET_sv_refcnt_add(SvREFCNT(bytecode_sv), arg);
break;
}
case INSN_SV_FLAGS: /* 16 */
{
U32 arg;
BGET_U32(arg);
- SvFLAGS(PL_bytecode_sv) = arg;
+ SvFLAGS(bytecode_sv) = arg;
break;
}
case INSN_XRV: /* 17 */
{
svindex arg;
BGET_svindex(arg);
- SvRV(PL_bytecode_sv) = arg;
+ SvRV(bytecode_sv) = arg;
break;
}
case INSN_XPV: /* 18 */
{
- BSET_xpv(PL_bytecode_sv);
+ BSET_xpv(bytecode_sv);
break;
}
case INSN_XIV32: /* 19 */
{
I32 arg;
BGET_I32(arg);
- SvIVX(PL_bytecode_sv) = arg;
+ SvIVX(bytecode_sv) = arg;
break;
}
case INSN_XIV64: /* 20 */
{
IV64 arg;
BGET_IV64(arg);
- SvIVX(PL_bytecode_sv) = arg;
+ SvIVX(bytecode_sv) = arg;
break;
}
case INSN_XNV: /* 21 */
{
double arg;
BGET_double(arg);
- SvNVX(PL_bytecode_sv) = arg;
+ SvNVX(bytecode_sv) = arg;
break;
}
case INSN_XLV_TARGOFF: /* 22 */
{
STRLEN arg;
BGET_U32(arg);
- LvTARGOFF(PL_bytecode_sv) = arg;
+ LvTARGOFF(bytecode_sv) = arg;
break;
}
case INSN_XLV_TARGLEN: /* 23 */
{
STRLEN arg;
BGET_U32(arg);
- LvTARGLEN(PL_bytecode_sv) = arg;
+ LvTARGLEN(bytecode_sv) = arg;
break;
}
case INSN_XLV_TARG: /* 24 */
{
svindex arg;
BGET_svindex(arg);
- LvTARG(PL_bytecode_sv) = arg;
+ LvTARG(bytecode_sv) = arg;
break;
}
case INSN_XLV_TYPE: /* 25 */
{
char arg;
BGET_U8(arg);
- LvTYPE(PL_bytecode_sv) = arg;
+ LvTYPE(bytecode_sv) = arg;
break;
}
case INSN_XBM_USEFUL: /* 26 */
{
I32 arg;
BGET_I32(arg);
- BmUSEFUL(PL_bytecode_sv) = arg;
+ BmUSEFUL(bytecode_sv) = arg;
break;
}
case INSN_XBM_PREVIOUS: /* 27 */
{
U16 arg;
BGET_U16(arg);
- BmPREVIOUS(PL_bytecode_sv) = arg;
+ BmPREVIOUS(bytecode_sv) = arg;
break;
}
case INSN_XBM_RARE: /* 28 */
{
U8 arg;
BGET_U8(arg);
- BmRARE(PL_bytecode_sv) = arg;
+ BmRARE(bytecode_sv) = arg;
break;
}
case INSN_XFM_LINES: /* 29 */
{
I32 arg;
BGET_I32(arg);
- FmLINES(PL_bytecode_sv) = arg;
+ FmLINES(bytecode_sv) = arg;
break;
}
case INSN_XIO_LINES: /* 30 */
{
long arg;
BGET_I32(arg);
- IoLINES(PL_bytecode_sv) = arg;
+ IoLINES(bytecode_sv) = arg;
break;
}
case INSN_XIO_PAGE: /* 31 */
{
long arg;
BGET_I32(arg);
- IoPAGE(PL_bytecode_sv) = arg;
+ IoPAGE(bytecode_sv) = arg;
break;
}
case INSN_XIO_PAGE_LEN: /* 32 */
{
long arg;
BGET_I32(arg);
- IoPAGE_LEN(PL_bytecode_sv) = arg;
+ IoPAGE_LEN(bytecode_sv) = arg;
break;
}
case INSN_XIO_LINES_LEFT: /* 33 */
{
long arg;
BGET_I32(arg);
- IoLINES_LEFT(PL_bytecode_sv) = arg;
+ IoLINES_LEFT(bytecode_sv) = arg;
break;
}
case INSN_XIO_TOP_NAME: /* 34 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoTOP_NAME(PL_bytecode_sv) = arg;
+ IoTOP_NAME(bytecode_sv) = arg;
break;
}
case INSN_XIO_TOP_GV: /* 36 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoTOP_GV(PL_bytecode_sv) = arg;
+ *(SV**)&IoTOP_GV(bytecode_sv) = arg;
break;
}
case INSN_XIO_FMT_NAME: /* 37 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoFMT_NAME(PL_bytecode_sv) = arg;
+ IoFMT_NAME(bytecode_sv) = arg;
break;
}
case INSN_XIO_FMT_GV: /* 38 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoFMT_GV(PL_bytecode_sv) = arg;
+ *(SV**)&IoFMT_GV(bytecode_sv) = arg;
break;
}
case INSN_XIO_BOTTOM_NAME: /* 39 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoBOTTOM_NAME(PL_bytecode_sv) = arg;
+ IoBOTTOM_NAME(bytecode_sv) = arg;
break;
}
case INSN_XIO_BOTTOM_GV: /* 40 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoBOTTOM_GV(PL_bytecode_sv) = arg;
+ *(SV**)&IoBOTTOM_GV(bytecode_sv) = arg;
break;
}
case INSN_XIO_SUBPROCESS: /* 41 */
{
short arg;
BGET_U16(arg);
- IoSUBPROCESS(PL_bytecode_sv) = arg;
+ IoSUBPROCESS(bytecode_sv) = arg;
break;
}
case INSN_XIO_TYPE: /* 42 */
{
char arg;
BGET_U8(arg);
- IoTYPE(PL_bytecode_sv) = arg;
+ IoTYPE(bytecode_sv) = arg;
break;
}
case INSN_XIO_FLAGS: /* 43 */
{
char arg;
BGET_U8(arg);
- IoFLAGS(PL_bytecode_sv) = arg;
+ IoFLAGS(bytecode_sv) = arg;
break;
}
case INSN_XCV_STASH: /* 44 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvSTASH(PL_bytecode_sv) = arg;
+ *(SV**)&CvSTASH(bytecode_sv) = arg;
break;
}
case INSN_XCV_START: /* 45 */
{
opindex arg;
BGET_opindex(arg);
- CvSTART(PL_bytecode_sv) = arg;
+ CvSTART(bytecode_sv) = arg;
break;
}
case INSN_XCV_ROOT: /* 46 */
{
opindex arg;
BGET_opindex(arg);
- CvROOT(PL_bytecode_sv) = arg;
+ CvROOT(bytecode_sv) = arg;
break;
}
case INSN_XCV_GV: /* 47 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvGV(PL_bytecode_sv) = arg;
+ *(SV**)&CvGV(bytecode_sv) = arg;
break;
}
case INSN_XCV_FILEGV: /* 48 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvFILEGV(PL_bytecode_sv) = arg;
+ *(SV**)&CvFILEGV(bytecode_sv) = arg;
break;
}
case INSN_XCV_DEPTH: /* 49 */
{
long arg;
BGET_I32(arg);
- CvDEPTH(PL_bytecode_sv) = arg;
+ CvDEPTH(bytecode_sv) = arg;
break;
}
case INSN_XCV_PADLIST: /* 50 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvPADLIST(PL_bytecode_sv) = arg;
+ *(SV**)&CvPADLIST(bytecode_sv) = arg;
break;
}
case INSN_XCV_OUTSIDE: /* 51 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvOUTSIDE(PL_bytecode_sv) = arg;
+ *(SV**)&CvOUTSIDE(bytecode_sv) = arg;
break;
}
case INSN_XCV_FLAGS: /* 52 */
{
U8 arg;
BGET_U8(arg);
- CvFLAGS(PL_bytecode_sv) = arg;
+ CvFLAGS(bytecode_sv) = arg;
break;
}
case INSN_AV_EXTEND: /* 53 */
{
SSize_t arg;
BGET_I32(arg);
- BSET_av_extend(PL_bytecode_sv, arg);
+ BSET_av_extend(bytecode_sv, arg);
break;
}
case INSN_AV_PUSH: /* 54 */
{
svindex arg;
BGET_svindex(arg);
- BSET_av_push(PL_bytecode_sv, arg);
+ BSET_av_push(bytecode_sv, arg);
break;
}
case INSN_XAV_FILL: /* 55 */
{
SSize_t arg;
BGET_I32(arg);
- AvFILLp(PL_bytecode_sv) = arg;
+ AvFILLp(bytecode_sv) = arg;
break;
}
case INSN_XAV_MAX: /* 56 */
{
SSize_t arg;
BGET_I32(arg);
- AvMAX(PL_bytecode_sv) = arg;
+ AvMAX(bytecode_sv) = arg;
break;
}
case INSN_XAV_FLAGS: /* 57 */
{
U8 arg;
BGET_U8(arg);
- AvFLAGS(PL_bytecode_sv) = arg;
+ AvFLAGS(bytecode_sv) = arg;
break;
}
case INSN_XHV_RITER: /* 58 */
{
I32 arg;
BGET_I32(arg);
- HvRITER(PL_bytecode_sv) = arg;
+ HvRITER(bytecode_sv) = arg;
break;
}
case INSN_XHV_NAME: /* 59 */
{
pvcontents arg;
BGET_pvcontents(arg);
- HvNAME(PL_bytecode_sv) = arg;
+ HvNAME(bytecode_sv) = arg;
break;
}
case INSN_HV_STORE: /* 60 */
{
svindex arg;
BGET_svindex(arg);
- BSET_hv_store(PL_bytecode_sv, arg);
+ BSET_hv_store(bytecode_sv, arg);
break;
}
case INSN_SV_MAGIC: /* 61 */
{
char arg;
BGET_U8(arg);
- BSET_sv_magic(PL_bytecode_sv, arg);
+ BSET_sv_magic(bytecode_sv, arg);
break;
}
case INSN_MG_OBJ: /* 62 */
{
svindex arg;
BGET_svindex(arg);
- SvMAGIC(PL_bytecode_sv)->mg_obj = arg;
+ SvMAGIC(bytecode_sv)->mg_obj = arg;
break;
}
case INSN_MG_PRIVATE: /* 63 */
{
U16 arg;
BGET_U16(arg);
- SvMAGIC(PL_bytecode_sv)->mg_private = arg;
+ SvMAGIC(bytecode_sv)->mg_private = arg;
break;
}
case INSN_MG_FLAGS: /* 64 */
{
U8 arg;
BGET_U8(arg);
- SvMAGIC(PL_bytecode_sv)->mg_flags = arg;
+ SvMAGIC(bytecode_sv)->mg_flags = arg;
break;
}
case INSN_MG_PV: /* 65 */
{
pvcontents arg;
BGET_pvcontents(arg);
- BSET_mg_pv(SvMAGIC(PL_bytecode_sv), arg);
+ BSET_mg_pv(SvMAGIC(bytecode_sv), arg);
break;
}
case INSN_XMG_STASH: /* 66 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&SvSTASH(PL_bytecode_sv) = arg;
+ *(SV**)&SvSTASH(bytecode_sv) = arg;
break;
}
case INSN_GV_FETCHPV: /* 67 */
{
strconst arg;
BGET_strconst(arg);
- BSET_gv_fetchpv(PL_bytecode_sv, arg);
+ BSET_gv_fetchpv(bytecode_sv, arg);
break;
}
case INSN_GV_STASHPV: /* 68 */
{
strconst arg;
BGET_strconst(arg);
- BSET_gv_stashpv(PL_bytecode_sv, arg);
+ BSET_gv_stashpv(bytecode_sv, arg);
break;
}
case INSN_GP_SV: /* 69 */
{
svindex arg;
BGET_svindex(arg);
- GvSV(PL_bytecode_sv) = arg;
+ GvSV(bytecode_sv) = arg;
break;
}
case INSN_GP_REFCNT: /* 70 */
{
U32 arg;
BGET_U32(arg);
- GvREFCNT(PL_bytecode_sv) = arg;
+ GvREFCNT(bytecode_sv) = arg;
break;
}
case INSN_GP_REFCNT_ADD: /* 71 */
{
I32 arg;
BGET_I32(arg);
- BSET_gp_refcnt_add(GvREFCNT(PL_bytecode_sv), arg);
+ BSET_gp_refcnt_add(GvREFCNT(bytecode_sv), arg);
break;
}
case INSN_GP_AV: /* 72 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvAV(PL_bytecode_sv) = arg;
+ *(SV**)&GvAV(bytecode_sv) = arg;
break;
}
case INSN_GP_HV: /* 73 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvHV(PL_bytecode_sv) = arg;
+ *(SV**)&GvHV(bytecode_sv) = arg;
break;
}
case INSN_GP_CV: /* 74 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvCV(PL_bytecode_sv) = arg;
+ *(SV**)&GvCV(bytecode_sv) = arg;
break;
}
case INSN_GP_FILEGV: /* 75 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvFILEGV(PL_bytecode_sv) = arg;
+ *(SV**)&GvFILEGV(bytecode_sv) = arg;
break;
}
case INSN_GP_IO: /* 76 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvIOp(PL_bytecode_sv) = arg;
+ *(SV**)&GvIOp(bytecode_sv) = arg;
break;
}
case INSN_GP_FORM: /* 77 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvFORM(PL_bytecode_sv) = arg;
+ *(SV**)&GvFORM(bytecode_sv) = arg;
break;
}
case INSN_GP_CVGEN: /* 78 */
{
U32 arg;
BGET_U32(arg);
- GvCVGEN(PL_bytecode_sv) = arg;
+ GvCVGEN(bytecode_sv) = arg;
break;
}
case INSN_GP_LINE: /* 79 */
{
line_t arg;
BGET_U16(arg);
- GvLINE(PL_bytecode_sv) = arg;
+ GvLINE(bytecode_sv) = arg;
break;
}
case INSN_GP_SHARE: /* 80 */
{
svindex arg;
BGET_svindex(arg);
- BSET_gp_share(PL_bytecode_sv, arg);
+ BSET_gp_share(bytecode_sv, arg);
break;
}
case INSN_XGV_FLAGS: /* 81 */
{
U8 arg;
BGET_U8(arg);
- GvFLAGS(PL_bytecode_sv) = arg;
+ GvFLAGS(bytecode_sv) = arg;
break;
}
case INSN_OP_NEXT: /* 82 */
diff --git a/byterun.h b/ext/ByteLoader/byterun.h
index 3aac6fa9b9..f95f9f8de2 100644
--- a/byterun.h
+++ b/ext/ByteLoader/byterun.h
@@ -8,14 +8,12 @@
/*
* This file is autogenerated from bytecode.pl. Changes made here will be lost.
*/
-#ifdef INDIRECT_BGET_MACROS
struct bytestream {
void *data;
int (*fgetc)(void *);
- int (*fread)(char *, size_t, size_t, void*);
- void (*freadpv)(U32, void*);
+ int (*fread)(char *, size_t, size_t, void *);
+ void (*freadpv)(U32, void *, XPV *);
};
-#endif /* INDIRECT_BGET_MACROS */
enum {
INSN_RET, /* 0 */
@@ -156,28 +154,3 @@ enum {
OPt_COP /* 11 */
};
-EXT int optype_size[]
-#ifdef DOINIT
-= {
- sizeof(OP),
- sizeof(UNOP),
- sizeof(BINOP),
- sizeof(LOGOP),
- sizeof(CONDOP),
- sizeof(LISTOP),
- sizeof(PMOP),
- sizeof(SVOP),
- sizeof(GVOP),
- sizeof(PVOP),
- sizeof(LOOP),
- sizeof(COP)
-}
-#endif /* DOINIT */
-;
-
-#define INIT_SPECIALSV_LIST STMT_START { \
- PL_specialsv_list[0] = Nullsv; \
- PL_specialsv_list[1] = &PL_sv_undef; \
- PL_specialsv_list[2] = &PL_sv_yes; \
- PL_specialsv_list[3] = &PL_sv_no; \
- } STMT_END
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 02595e50a5..30ee2e5989 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -468,30 +468,12 @@ sub input_record_separator {
}
sub input_line_number {
- # local $. does not work properly, so we need to do it some other
- # way. We use select, although this is not quite right. What we
- # really need to know is the file handle that was the subject of the
- # last read, seek or tell.
- my $now = select;
- my $keep = $.;
- my $tell = tell qualify($_[0], caller) if ref($_[0]);
- my $prev = $.;
- $. = $_[1] if @_ > 1;
- no strict "refs";
- $tell = tell $now;
- $. = $keep;
- $prev;
-}
-
-=for when local $. works properly
-sub input_line_number {
local $.;
my $tell = tell qualify($_[0], caller) if ref($_[0]);
my $prev = $.;
$. = $_[1] if @_ > 1;
$prev;
}
-=cut
sub format_page_number {
my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
diff --git a/ext/IO/poll.c b/ext/IO/poll.c
index 5d806b60f3..0f8c8434f2 100644
--- a/ext/IO/poll.c
+++ b/ext/IO/poll.c
@@ -26,6 +26,12 @@
#include <sys/stat.h>
#include <errno.h>
+#ifdef HAS_SELECT
+#ifdef I_SYS_SELECT
+#include <sys/select.h>
+#endif
+#endif
+
#ifdef EMULATE_POLL_WITH_SELECT
# define POLL_CAN_READ (POLLIN | POLLRDNORM )
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
index f5bc0f9a6a..60b141e230 100644
--- a/ext/NDBM_File/NDBM_File.xs
+++ b/ext/NDBM_File/NDBM_File.xs
@@ -35,10 +35,10 @@ typedef datum datum_value ;
}
-MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = dbm_
+MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_
NDBM_File
-dbm_TIEHASH(dbtype, filename, flags, mode)
+ndbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
char * filename
int flags
@@ -59,20 +59,20 @@ dbm_TIEHASH(dbtype, filename, flags, mode)
RETVAL
void
-dbm_DESTROY(db)
+ndbm_DESTROY(db)
NDBM_File db
CODE:
dbm_close(db->dbp);
-#define dbm_FETCH(db,key) dbm_fetch(db->dbp,key)
+#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
datum_value
-dbm_FETCH(db, key)
+ndbm_FETCH(db, key)
NDBM_File db
datum_key key
-#define dbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags)
+#define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags)
int
-dbm_STORE(db, key, value, flags = DBM_REPLACE)
+ndbm_STORE(db, key, value, flags = DBM_REPLACE)
NDBM_File db
datum_key key
datum_value value
@@ -86,31 +86,31 @@ dbm_STORE(db, key, value, flags = DBM_REPLACE)
dbm_clearerr(db->dbp);
}
-#define dbm_DELETE(db,key) dbm_delete(db->dbp,key)
+#define ndbm_DELETE(db,key) dbm_delete(db->dbp,key)
int
-dbm_DELETE(db, key)
+ndbm_DELETE(db, key)
NDBM_File db
datum_key key
-#define dbm_FIRSTKEY(db) dbm_firstkey(db->dbp)
+#define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp)
datum_key
-dbm_FIRSTKEY(db)
+ndbm_FIRSTKEY(db)
NDBM_File db
-#define dbm_NEXTKEY(db,key) dbm_nextkey(db->dbp)
+#define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp)
datum_key
-dbm_NEXTKEY(db, key)
+ndbm_NEXTKEY(db, key)
NDBM_File db
datum_key key
-#define dbm_error(db) dbm_error(db->dbp)
+#define ndbm_error(db) dbm_error(db->dbp)
int
-dbm_error(db)
+ndbm_error(db)
NDBM_File db
-#define dbm_clearerr(db) dbm_clearerr(db->dbp)
+#define ndbm_clearerr(db) dbm_clearerr(db->dbp)
void
-dbm_clearerr(db)
+ndbm_clearerr(db)
NDBM_File db
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 80e92ff2fc..4a5a2a0743 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -138,8 +138,12 @@
#else
# ifndef HAS_MKFIFO
-# ifndef mkfifo
-# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
+# ifdef OS2
+# define mkfifo(a,b) not_here("mkfifo")
+# else /* !( defined OS2 ) */
+# ifndef mkfifo
+# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
+# endif
# endif
# endif /* !HAS_MKFIFO */
diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index b2b145577f..336e6c451a 100644
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -929,12 +929,37 @@ pack_sockaddr_un(pathname)
#ifdef I_SYS_UN
struct sockaddr_un sun_ad; /* fear using sun */
STRLEN len;
+
Zero( &sun_ad, sizeof sun_ad, char );
sun_ad.sun_family = AF_UNIX;
len = strlen(pathname);
if (len > sizeof(sun_ad.sun_path))
len = sizeof(sun_ad.sun_path);
+# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
+ {
+ int off;
+ char *s, *e;
+
+ if (pathname[0] != '/' && pathname[0] != '\\')
+ croak("Relative UNIX domain socket name '%s' unsupported", pathname);
+ else if (len < 8
+ || pathname[7] != '/' && pathname[7] != '\\'
+ || !strnicmp(pathname + 1, "socket", 6))
+ off = 7;
+ else
+ off = 0; /* Preserve names starting with \socket\ */
+ Copy( "\\socket", sun_ad.sun_path, off, char);
+ Copy( pathname, sun_ad.sun_path + off, len, char );
+
+ s = sun_ad.sun_path + off - 1;
+ e = s + len + 1;
+ while (++s < e)
+ if (*s = '/')
+ *s = '\\';
+ }
+# else /* !( defined OS2 ) */
Copy( pathname, sun_ad.sun_path, len, char );
+# endif
ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
#else
ST(0) = (SV *) not_here("pack_sockaddr_un");
diff --git a/global.sym b/global.sym
index 44417d9444..44f436101f 100644
--- a/global.sym
+++ b/global.sym
@@ -33,7 +33,6 @@ block_gimme
block_start
boot_core_UNIVERSAL
bset_obj_store
-byterun
call_list
cando
cast_ulong
@@ -154,7 +153,6 @@ get_op_descs
get_op_names
get_no_modify
get_opargs
-get_specialsv_list
get_vtbl
gp_free
gp_ref
diff --git a/hints/openbsd.sh b/hints/openbsd.sh
index 3f4c96f6e0..4ae2611b07 100644
--- a/hints/openbsd.sh
+++ b/hints/openbsd.sh
@@ -4,6 +4,9 @@
# Edited to allow Configure command-line overrides by
# Andy Dougherty <doughera@lafcol.lafayette.edu>
#
+# To build with distribution paths, use:
+# ./Configure -des -Dopenbsd_distribution
+#
# OpenBSD has a better malloc than perl...
test "$usemymalloc" || usemymalloc='n'
@@ -68,4 +71,21 @@ $define|true|[yY]*)
esac
EOCBU
+# When building in the OpenBSD tree we use different paths
+# This is only part of the story, the rest comes from config.over
+case "$openbsd_distribution" in
+''|$undef|false|[nN]*) ;;
+*)
+ # We put things in /usr, not /usr/local
+ prefix='/usr'
+ prefixexp='/usr'
+ sysman='/usr/share/man/man1'
+ # Never look for things in /usr/local
+ glibpth='/usr/lib'
+ libpth='/usr/lib'
+ locincpth=''
+ loclibpth=''
+ ;;
+esac
+
# end
diff --git a/hints/os2.sh b/hints/os2.sh
index 5365522c5a..e49ab7f124 100644
--- a/hints/os2.sh
+++ b/hints/os2.sh
@@ -257,9 +257,56 @@ d_setprior='define'
# Commented:
#startsh='extproc ksh\\n#! sh'
+# Find patch:
+gnupatch='patch'
+if (gnupatch -v || gnupatch --version) 2>&1 >/dev/null; then
+ gnupatch=gnupatch
+else
+ if (gpatch -v || gpatch --version) 2>&1 >/dev/null; then
+ gnupatch=gpatch
+ else
+ # They may have a special PATH during configuring
+ if (patch -v || patch --version) 2>&1 >/dev/null; then
+ gnupatch="`./UU/loc patch.exe undef $pth`"
+ fi
+ fi
+fi
+
+# Apply patches if needed
+case "$0$running_c_cmd" in
+ *[/\\]Configure|*[/\\]Configure.|Configure|Configure.) # Skip Configure.cmd
+ if grep "^libnames" ./Configure > /dev/null; then
+ # Not patched!
+ if test -f ./Configure.cmd ; then
+ echo "!!!" >&2
+ echo "!!! ./Configure not patched, but ./Configure.cmd exits" >&2
+ echo "!!! Do not know what to do!" >&2
+ echo "!!!" >&2
+ exit 2
+ fi
+ echo "!!!" >&2
+ echo "!!! You did not patch ./Configure!" >&2
+ echo "!!! I create Configure.cmd and patch it from ./os2/diff.configure." >&2
+ echo "!!!" >&2
+ echo "$gnupatch -b -p1 --output=Configure.cmd <./os2/diff.configure 2>&1 | tee 00_auto_patch" >&2
+ ($gnupatch -b -p1 --output=Configure.cmd <./os2/diff.configure 2>&1 | tee 00_auto_patch) >&2
+ echo "!!!" >&2
+ echo "!!! The report of patching is copied to 00_auto_patch." >&2
+ echo "!!! Now you need to restart Configure.cmd with all the options" >&2
+ echo "!!!" >&2
+ echo "extproc sh" > Configure.ctm
+ cat Configure.cmd >> Configure.ctm && mv -f Configure.ctm Configure.cmd
+ exit 0
+ else
+ echo "!!! Apparently we are running a patched Configure." >&2
+ fi
+ ;;
+ *) echo "!!! Apparently we are running a renamed Configure: '$0'." >&2
+esac
+
# Copy pod:
-cp ./README.os2 ./pod/perlos2.pod
+cp -uf ./README.os2 ./pod/perlos2.pod
# This script UU/usethreads.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use threads.
diff --git a/hints/sunos_4_1.sh b/hints/sunos_4_1.sh
index 6d94bdbd1f..af0bca1398 100644
--- a/hints/sunos_4_1.sh
+++ b/hints/sunos_4_1.sh
@@ -30,7 +30,15 @@ d_tzname='undef'
i_unistd='undef'
# See util.c for another: We need _SC_OPEN_MAX, which is in
# <unistd.h>.
-util_cflags='ccflags="$ccflags -DI_UNISTD"'
+
+# fflush(NULL) will core dump on SunOS 4.1.3. In util.c we'll
+# try explicitly fflushing all open files. Unfortunately,
+# on my SunOS 4.1.3 system, sysconf(_SC_OPEN_MAX) returns
+# 64, but only 32 of those file pointers can be accessed
+# directly by _iob[i]. The remainder are off in dynamically
+# allocated memory somewhere and I don't know to automatically
+# fflush() them. -- Andy Dougherty Wed May 26 15:25:22 EDT 1999
+util_cflags='ccflags="$ccflags -DPERL_FFLUSH_ALL_FOPEN_MAX=32"'
cat << 'EOM' >&4
diff --git a/intrpvar.h b/intrpvar.h
index e4f112e222..d28d1987bb 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -200,12 +200,6 @@ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */
PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */
#endif /* USE_THREADS */
-PERLVARI(Ibytecode_iv_overflows,int, 0) /* from bytecode.h */
-PERLVAR(Ibytecode_sv, SV *)
-PERLVAR(Ibytecode_pv, XPV)
-PERLVAR(Ibytecode_obj_list, void **)
-PERLVARI(Ibytecode_obj_list_fill, I32, -1)
-
#ifdef PERL_OBJECT
PERLVARI(piMem, IPerlMem*, NULL)
PERLVARI(piENV, IPerlEnv*, NULL)
diff --git a/lib/Carp.pm b/lib/Carp.pm
index f8f750a5d7..5fb8809900 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -215,7 +215,7 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages
# merge all the caller's @ISA packages into %isa.
@isa{@{"${prevpack}::ISA"}} = ()
- if(defined @{"${prevpack}::ISA"});
+ if(@{"${prevpack}::ISA"});
# now we crawl up the calling stack and look at all the packages in
# there. For each package, we look to see if it has an @ISA and then
@@ -223,7 +223,7 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages
# our caller is a derived class of that package and its calls can also
# be ignored
while (($pack,$file,$line) = caller($i++)) {
- if(defined @{$pack . "::ISA"}) {
+ if(@{$pack . "::ISA"}) {
my @i = @{$pack . "::ISA"};
my %i;
@i{@i} = ();
@@ -247,7 +247,7 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages
if ($extra-- > 0) {
%isa = ($pack,1);
@isa{@{$pack . "::ISA"}} = ()
- if(defined @{$pack . "::ISA"});
+ if(@{$pack . "::ISA"});
}
else {
# OK! We've got a candidate package. Time to construct the
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 0435cd89e8..8aa6a6604b 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -74,6 +74,7 @@ sub fnorm; sub fsqrt;
sub fnorm { #(string) return fnum_str
local($_) = @_;
s/\s+//g; # strip white space
+ local $^W = 0; # $4 and $5 below might legitimately be undefined
if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
} else {
diff --git a/objXSUB.h b/objXSUB.h
index d37a925037..857a942f0b 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -62,16 +62,6 @@
#define PL_bufend pPerl->PL_bufend
#undef PL_bufptr
#define PL_bufptr pPerl->PL_bufptr
-#undef PL_bytecode_iv_overflows
-#define PL_bytecode_iv_overflows pPerl->PL_bytecode_iv_overflows
-#undef PL_bytecode_obj_list
-#define PL_bytecode_obj_list pPerl->PL_bytecode_obj_list
-#undef PL_bytecode_obj_list_fill
-#define PL_bytecode_obj_list_fill pPerl->PL_bytecode_obj_list_fill
-#undef PL_bytecode_pv
-#define PL_bytecode_pv pPerl->PL_bytecode_pv
-#undef PL_bytecode_sv
-#define PL_bytecode_sv pPerl->PL_bytecode_sv
#undef PL_cddir
#define PL_cddir pPerl->PL_cddir
#undef PL_chopset
@@ -648,8 +638,6 @@
#define PL_sortcxix pPerl->PL_sortcxix
#undef PL_sortstash
#define PL_sortstash pPerl->PL_sortstash
-#undef PL_specialsv_list
-#define PL_specialsv_list pPerl->PL_specialsv_list
#undef PL_splitstr
#define PL_splitstr pPerl->PL_splitstr
#undef PL_srand_called
@@ -883,8 +871,6 @@
#define boot_core_UNIVERSAL pPerl->Perl_boot_core_UNIVERSAL
#undef bset_obj_store
#define bset_obj_store pPerl->Perl_bset_obj_store
-#undef byterun
-#define byterun pPerl->Perl_byterun
#undef cache_re
#define cache_re pPerl->Perl_cache_re
#undef call_list
@@ -1237,8 +1223,6 @@
#define get_op_names pPerl->Perl_get_op_names
#undef get_opargs
#define get_opargs pPerl->Perl_get_opargs
-#undef get_specialsv_list
-#define get_specialsv_list pPerl->Perl_get_specialsv_list
#undef get_vtbl
#define get_vtbl pPerl->Perl_get_vtbl
#undef gp_free
diff --git a/op.c b/op.c
index 88cc607daf..2bfd9041be 100644
--- a/op.c
+++ b/op.c
@@ -5008,6 +5008,30 @@ ck_lfun(OP *o)
}
OP *
+ck_defined(OP *o) /* 19990527 MJD */
+{
+ if (ckWARN(WARN_DEPRECATED)) {
+ switch (cUNOPo->op_first->op_type) {
+ case OP_RV2AV:
+ case OP_PADAV:
+ case OP_AASSIGN: /* Is this a good idea? */
+ warner(WARN_DEPRECATED, "defined(@array) is deprecated (and not really meaningful)");
+ warner(WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+ break;
+ case OP_RV2HV:
+ case OP_PADHV:
+ warner(WARN_DEPRECATED, "defined(%hash) is deprecated (and not really meaningful)");
+ warner(WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+ break;
+ default:
+ /* no warning */
+ break;
+ }
+ }
+ return ck_rfun(o);
+}
+
+OP *
ck_rfun(OP *o)
{
OPCODE type = o->op_type;
diff --git a/op.h b/op.h
index 125e115175..bb5bf87cbe 100644
--- a/op.h
+++ b/op.h
@@ -79,6 +79,7 @@ typedef U32 PADOFFSET;
/* On OP_ENTERSUB || OP_NULL, saw a "do". */
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
/* On OP_ENTERITER, loop var is per-thread */
+ /* On pushre, re is /\s+/ imp. by split " " */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST OPf_WANT_LIST
diff --git a/opcode.h b/opcode.h
index a4efb5acba..b6143eac72 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1482,7 +1482,7 @@ EXT OP * (CPERLscope(*PL_check)[]) _((OP *op)) = {
ck_null, /* schop */
ck_spair, /* chomp */
ck_null, /* schomp */
- ck_rfun, /* defined */
+ ck_defined, /* defined */
ck_lfun, /* undef */
ck_fun, /* study */
ck_lfun, /* pos */
diff --git a/opcode.pl b/opcode.pl
index 7b6e79655b..c763675864 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -307,7 +307,7 @@ chop chop ck_spair mts% L
schop scalar chop ck_null stu% S?
chomp safe chop ck_spair mts% L
schomp scalar safe chop ck_null stu% S?
-defined defined operator ck_rfun isu% S?
+defined defined operator ck_defined isu% S?
undef undef operator ck_lfun s% S?
study study ck_fun su% S?
pos match position ck_lfun stu% S?
diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs
index ced556af9e..c732aced9f 100644
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -35,12 +35,13 @@ LD_OPT = $optimize
PERL_DLL_BASE = perl$dll_post
PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
+TEST_PERL_DLL = perl_dll_t
CONFIG_ARGS = $config_args
!GROK!THIS!
$spitshell >>Makefile <<'!NO!SUBS!'
-$(LIBPERL): perl.imp $(PERL_DLL) perl5.def
+$(LIBPERL): perl.imp perl_dll perl5.def
emximp -o $(LIBPERL) perl.imp
$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
@@ -55,6 +56,11 @@ perl.imp: perl5.def
perl_dll: $(PERL_DLL)
+perl_dll_t: t/$(PERL_DLL)
+
+t/$(PERL_DLL): $(PERL_DLL)
+ $(LNS) $(PERL_DLL) t/$(PERL_DLL)
+
$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
diff --git a/os2/os2.c b/os2/os2.c
index 7f011f7fea..09135a6490 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -412,6 +412,7 @@ result(int flag, int pid)
#define EXECF_EXEC 1
#define EXECF_TRUEEXEC 2
#define EXECF_SPAWN_NOWAIT 3
+#define EXECF_SPAWN_BYFLAG 4
/* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
@@ -587,7 +588,7 @@ U32 addflag;
rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
rc = spawnvp(flag,tmps,PL_Argv);
- else /* EXECF_SPAWN */
+ else /* EXECF_SPAWN, EXECF_SPAWN_BYFLAG */
rc = result(trueflag,
spawnvp(flag,tmps,PL_Argv));
#endif
@@ -813,49 +814,9 @@ U32 addflag;
return rc;
}
-/* Array spawn. */
-int
-do_aspawn(really,mark,sp)
-SV *really;
-register SV **mark;
-register SV **sp;
-{
- dTHR;
- register char **a;
- char *tmps = NULL;
- int rc;
- int flag = P_WAIT, trueflag, err, secondtry = 0;
- STRLEN n_a;
-
- if (sp > mark) {
- New(1301,PL_Argv, sp - mark + 3, char*);
- a = PL_Argv;
-
- if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
- ++mark;
- flag = SvIVx(*mark);
- }
-
- while (++mark <= sp) {
- if (*mark)
- *a++ = SvPVx(*mark, n_a);
- else
- *a++ = "";
- }
- *a = Nullch;
-
- rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
- } else
- rc = -1;
- do_execfree();
- return rc;
-}
-
/* Try converting 1-arg form to (usually shell-less) multi-arg form. */
int
-do_spawn2(cmd, execf)
-char *cmd;
-int execf;
+do_spawn3(char *cmd, int execf, int flag)
{
register char **a;
register char *s;
@@ -936,6 +897,8 @@ int execf;
rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
else if (execf == EXECF_SPAWN_NOWAIT)
rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
+ else if (execf == EXECF_SPAWN_BYFLAG)
+ rc = spawnl(flag,shell,shell,copt,cmd,(char*)0);
else {
/* In the ak code internal P_NOWAIT is P_WAIT ??? */
rc = result(P_WAIT,
@@ -968,7 +931,7 @@ int execf;
}
*a = Nullch;
if (PL_Argv[0])
- rc = do_spawn_ve(NULL, 0, execf, cmd, mergestderr);
+ rc = do_spawn_ve(NULL, flag, execf, cmd, mergestderr);
else
rc = -1;
if (news)
@@ -977,25 +940,67 @@ int execf;
return rc;
}
+/* Array spawn. */
+int
+do_aspawn(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+ dTHR;
+ register char **a;
+ int rc;
+ int flag = P_WAIT, flag_set = 0;
+ STRLEN n_a;
+
+ if (sp > mark) {
+ New(1301,PL_Argv, sp - mark + 3, char*);
+ a = PL_Argv;
+
+ if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
+ ++mark;
+ flag = SvIVx(*mark);
+ flag_set = 1;
+
+ }
+
+ while (++mark <= sp) {
+ if (*mark)
+ *a++ = SvPVx(*mark, n_a);
+ else
+ *a++ = "";
+ }
+ *a = Nullch;
+
+ if (flag_set && (a == PL_Argv + 1)) { /* One arg? */
+ rc = do_spawn3(a[-1], EXECF_SPAWN_BYFLAG, flag);
+ } else
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
+ } else
+ rc = -1;
+ do_execfree();
+ return rc;
+}
+
int
do_spawn(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_SPAWN);
+ return do_spawn3(cmd, EXECF_SPAWN, 0);
}
int
do_spawn_nowait(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
+ return do_spawn3(cmd, EXECF_SPAWN_NOWAIT,0);
}
bool
do_exec(cmd)
char *cmd;
{
- do_spawn2(cmd, EXECF_EXEC);
+ do_spawn3(cmd, EXECF_EXEC, 0);
return FALSE;
}
@@ -1003,7 +1008,7 @@ bool
os2exec(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_TRUEEXEC);
+ return do_spawn3(cmd, EXECF_TRUEEXEC, 0);
}
PerlIO *
diff --git a/os2/os2ish.h b/os2/os2ish.h
index cfd13c8335..6993dfca5d 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -68,6 +68,13 @@
#define BIT_BUCKET "/dev/nul" /* Will this work? */
+/* Apparently TCPIPV4 defines may be included even with only IAK present */
+
+#if !defined(NO_TCPIPV4) && !defined(TCPIPV4)
+# define TCPIPV4
+# define TCPIPV4_FORCED /* Just in case */
+#endif
+
#if defined(I_SYS_UN) && !defined(TCPIPV4)
/* It is not working without TCPIPV4 defined. */
# undef I_SYS_UN
diff --git a/perl.h b/perl.h
index f075f3aa80..97e130d9a7 100644
--- a/perl.h
+++ b/perl.h
@@ -1538,8 +1538,6 @@ union any {
#include "mg.h"
#include "scope.h"
#include "warning.h"
-#include "bytecode.h"
-#include "byterun.h"
#include "utf8.h"
/* Current curly descriptor */
diff --git a/perlvars.h b/perlvars.h
index 67dc7c181f..3e1a24b4bc 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -186,8 +186,6 @@ PERLVARIC(GNo, char *, "")
PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEF")
PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
-PERLVAR(Gspecialsv_list[4],SV *) /* from byterun.h */
-
/* perly.c globals */
PERLVAR(Gyydebug, int)
PERLVAR(Gyynerrs, int)
@@ -204,3 +202,4 @@ PERLVAR(Guudmap[256], char)
PERLVAR(Gbitcount, char *)
PERLVAR(Gfilter_debug, int)
+
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 5b4eb10553..9408d32c9d 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -473,6 +473,18 @@ by Perl.
(W) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
construction, but the command was missing or blank.
+=item defined(@array) is deprecated (and not really meaningful)
+
+(D) defined() is not usually useful on arrays because it checks for an
+undefined I<scalar> value. If you want to see if the array is empty,
+just use C<if (@array) { # not empty }> for example.
+
+=item defined(%hash) is deprecated (and not really meaningful)
+
+(D) defined() is not usually useful on hashes because it checks for an
+undefined I<scalar> value. If you want to see if the hash is empty,
+just use C<if (%hash) { # not empty }> for example.
+
=head1 Obsolete Diagnostics
Todo.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 688e847085..0084f9c6da 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1105,6 +1105,18 @@ times more than it has returned. This probably indicates an infinite
recursion, unless you're writing strange benchmark programs, in which
case it indicates something else.
+=item defined(@array) is deprecated (and not really meaningful)
+
+(D) defined() is not usually useful on arrays because it checks for an
+undefined I<scalar> value. If you want to see if the array is empty,
+just use C<if (@array) { # not empty }> for example.
+
+=item defined(%hash) is deprecated (and not really meaningful)
+
+(D) defined() is not usually useful on hashes because it checks for an
+undefined I<scalar> value. If you want to see if the hash is empty,
+just use C<if (%hash) { # not empty }> for example.
+
=item Delimiter for here document is too long
(F) In a here document construct like C<E<lt>E<lt>FOO>, the label
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index ed3de62a23..4043301a5e 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -912,24 +912,14 @@ should use C<defined> only when you're questioning the integrity of what
you're trying to do. At other times, a simple comparison to C<0> or C<""> is
what you want.
-Currently, using C<defined> on an entire array or hash reports whether
-memory for that aggregate has ever been allocated. So an array you set
-to the empty list appears undefined initially, and one that once was full
-and that you then set to the empty list still appears defined. You
-should instead use a simple test for size:
+Use of C<defined> on aggregates (hashes and arrays) is deprecated. It
+used to report whether memory for that aggregate has ever been
+allocated. This behavior may disappear in future versions of Perl.
+You should instead use a simple test for size:
if (@an_array) { print "has array elements\n" }
if (%a_hash) { print "has hash members\n" }
-Using C<undef> on these, however, does clear their memory and then report
-them as not defined anymore, but you shouldn't do that unless you don't
-plan to use them again, because it saves time when you load them up
-again to have memory already ready to be filled. The normal way to
-free up space used by an aggregate is to assign the empty list.
-
-This counterintuitive behavior of C<defined> on aggregates may be
-changed, fixed, or broken in a future release of Perl.
-
See also L</undef>, L</exists>, L</ref>.
=item delete EXPR
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index cb41c96aa0..9402608daf 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -220,8 +220,10 @@ to change that. An explicit close on a filehandle resets the line
number. Because C<E<lt>E<gt>> never does an explicit close, line
numbers increase across ARGV files (but see examples in L<perlfunc/eof>).
Consider this variable read-only: setting it does not reposition
-the seek pointer; you'll have to do that on your own. (Mnemonic:
-many programs use "." to mean the current line number.)
+the seek pointer; you'll have to do that on your own. Localizing C<$.>
+has the effect of also localizing Perl's notion of "the last read
+filehandle". (Mnemonic: many programs use "." to mean the current line
+number.)
=item input_record_separator HANDLE EXPR
diff --git a/pp_proto.h b/pp_proto.h
index 76ac6f499c..7f5728200d 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -2,6 +2,7 @@ PERL_CKDEF(ck_anoncode)
PERL_CKDEF(ck_bitop)
PERL_CKDEF(ck_concat)
PERL_CKDEF(ck_delete)
+PERL_CKDEF(ck_defined)
PERL_CKDEF(ck_eof)
PERL_CKDEF(ck_eval)
PERL_CKDEF(ck_exec)
diff --git a/pp_sys.c b/pp_sys.c
index c5344dfdea..bc5ccc063e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -17,8 +17,10 @@
#include "EXTERN.h"
#include "perl.h"
-#ifdef HAS_GETSPENT
-/* Shadow password support for solaris - pdo@cs.umd.edu*/
+#ifdef I_SHADOW
+/* Shadow password support for solaris - pdo@cs.umd.edu
+ * Not just Solaris: at least HP-UX, IRIX, Linux.
+ * the API is from SysV. --jhi */
#include <shadow.h>
#endif
@@ -4564,11 +4566,13 @@ PP(pp_gpwent)
else
pwent = (struct passwd *)getpwent();
-#ifdef HAS_GETSPENT
+#ifdef HAS_GETSPNAM
if (which == OP_GPWNAM)
spwent = getspnam(pwent->pw_name);
+# ifdef HAS_GETSPUID /* AFAIK there isn't any anywhere. --jhi */
else if (which == OP_GPWUID)
spwent = getspnam(pwent->pw_name);
+# endif
else
spwent = (struct spwd *)getspent();
#endif
@@ -4591,14 +4595,14 @@ PP(pp_gpwent)
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef PWPASSWD
-#ifdef HAS_GETSPENT
+# ifdef HAS_GETSPENT
if (spwent)
sv_setpv(sv, spwent->sp_pwdp);
else
sv_setpv(sv, pwent->pw_passwd);
-#else
+# else
sv_setpv(sv, pwent->pw_passwd);
-#endif
+# endif
#endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
@@ -4662,9 +4666,9 @@ PP(pp_spwent)
djSP;
#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32)
setpwent();
-#ifdef HAS_GETSPENT
+# ifdef HAS_SETSPENT
setspent();
-#endif
+# endif
RETPUSHYES;
#else
DIE(PL_no_func, "setpwent");
@@ -4676,9 +4680,9 @@ PP(pp_epwent)
djSP;
#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
endpwent();
-#ifdef HAS_GETSPENT
+# ifdef HAS_ENDSPENT
endspent();
-#endif
+# endif
RETPUSHYES;
#else
DIE(PL_no_func, "endpwent");
diff --git a/proto.h b/proto.h
index 89c70fc826..7c8f8a338d 100644
--- a/proto.h
+++ b/proto.h
@@ -933,7 +933,6 @@ void restore_expect _((void *e));
void restore_lex_expect _((void *e));
void yydestruct _((void *ptr));
VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...));
-VIRTUAL SV** get_specialsv_list _((void));
#ifdef WIN32
VIRTUAL int& ErrorNo _((void));
@@ -942,12 +941,6 @@ VIRTUAL int& ErrorNo _((void));
END_EXTERN_C
#endif /* PERL_OBJECT */
-#ifdef INDIRECT_BGET_MACROS
-VIRTUAL void byterun _((struct bytestream bs));
-#else
-VIRTUAL void byterun _((PerlIO *fp));
-#endif /* INDIRECT_BGET_MACROS */
-
VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...));
VIRTUAL void sv_catpv_mg _((SV *sv, const char *ptr));
VIRTUAL void sv_catpvn_mg _((SV *sv, const char *ptr, STRLEN len));
diff --git a/scope.h b/scope.h
index b217fea6b3..8358c54235 100644
--- a/scope.h
+++ b/scope.h
@@ -221,7 +221,7 @@ typedef void *(CPERLscope(*protect_proc_t)) _((int *, protect_body_t, ...));
#define dJMPENV JMPENV cur_env
-#define JMPENV_PUSH_INIT(THROWFUNC) \
+#define JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) \
STMT_START { \
cur_env.je_throw = (THROWFUNC); \
cur_env.je_ret = -1; \
@@ -230,23 +230,33 @@ typedef void *(CPERLscope(*protect_proc_t)) _((int *, protect_body_t, ...));
PL_top_env = &cur_env; \
OP_REG_TO_MEM; \
} STMT_END
-#define JMPENV_POST_CATCH \
+
+#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC)
+
+#define JMPENV_POST_CATCH_ENV(cur_env) \
STMT_START { \
OP_MEM_TO_REG; \
PL_top_env = &cur_env; \
} STMT_END
-#define JMPENV_PUSH(v) \
+#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(cur_env)
+
+
+#define JMPENV_PUSH_ENV(cur_env,v) \
STMT_START { \
- JMPENV_PUSH_INIT(NULL); \
- EXCEPT_SET(PerlProc_setjmp(cur_env.je_buf, 1)); \
- JMPENV_POST_CATCH; \
- (v) = EXCEPT_GET; \
+ JMPENV_PUSH_INIT_ENV(cur_env,NULL); \
+ EXCEPT_SET_ENV(cur_env,PerlProc_setjmp(cur_env.je_buf, 1)); \
+ JMPENV_POST_CATCH_ENV(cur_env); \
+ (v) = EXCEPT_GET_ENV(cur_env); \
} STMT_END
-#define JMPENV_POP \
+#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(cur_env,v)
+
+#define JMPENV_POP_ENV(cur_env) \
STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+#define JMPENV_POP JMPENV_POP_ENV(cur_env)
+
#define JMPENV_JUMP(v) \
STMT_START { \
OP_REG_TO_MEM; \
@@ -262,8 +272,10 @@ typedef void *(CPERLscope(*protect_proc_t)) _((int *, protect_body_t, ...));
PerlProc_exit(1); \
} STMT_END
-#define EXCEPT_GET (cur_env.je_ret)
-#define EXCEPT_SET(v) (cur_env.je_ret = (v))
+#define EXCEPT_GET_ENV(cur_env) (cur_env.je_ret)
+#define EXCEPT_GET EXCEPT_GET_ENV(cur_env)
+#define EXCEPT_SET_ENV(cur_env,v) (cur_env.je_ret = (v))
+#define EXCEPT_SET(v) EXCEPT_SET_ENV(cur_env,v)
#define CATCH_GET (PL_top_env->je_mustcatch)
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
diff --git a/t/TEST b/t/TEST
index 3685c2a45f..25b8a395ba 100755
--- a/t/TEST
+++ b/t/TEST
@@ -1,6 +1,6 @@
#!./perl
-# Last change: Fri Jan 10 09:57:03 WET 1997
+# Last change: Fri May 28 03:16:57 BST 1999
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
@@ -150,12 +150,12 @@ EOT
}
}
else {
- $pct = sprintf("%.2f", $good / $total * 100);
+ $pct = sprintf("%.2f", ($files - $bad) / $files * 100);
if ($bad == 1) {
- warn "Failed 1 test script out of $total, $pct% okay.\n";
+ warn "Failed 1 test script out of $files, $pct% okay.\n";
}
else {
- warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+ warn "Failed $bad test scripts out of $files, $pct% okay.\n";
}
warn <<'SHRDLU';
### Since not all tests were successful, you may want to run some
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 1c72440478..37949c4546 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -61,6 +61,7 @@ if ($^O eq 'vmesa') {
exec 'echo', 'not ok 6';
}
}
+wait; # Collect from $pid
pipe(READER,WRITER) || die "Can't open pipe";
close READER;
@@ -134,7 +135,6 @@ else {
}
# check that status for the correct process is collected
-wait; # Collect from $pid
my $zombie = fork or exit 37;
my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
$SIG{ALRM} = sub { return };
diff --git a/t/lib/bigfloatpm.t b/t/lib/bigfloatpm.t
index ebec667280..42cd9583d1 100755
--- a/t/lib/bigfloatpm.t
+++ b/t/lib/bigfloatpm.t
@@ -185,9 +185,9 @@ $Math::BigFloat::rnd_mode = 'trunc'
-1.35:-1:-1.3
-0.006:-1:0
-0.006:-2:0
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
$Math::BigFloat::rnd_mode = 'zero'
+2.23:-1:2.2
-2.23:-1:-2.2
@@ -198,10 +198,10 @@ $Math::BigFloat::rnd_mode = 'zero'
+2.35:-1:2.3
-2.35:-1:-2.3
-0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
$Math::BigFloat::rnd_mode = '+inf'
+3.23:-1:3.2
-3.23:-1:-3.2
@@ -212,10 +212,10 @@ $Math::BigFloat::rnd_mode = '+inf'
+3.35:-1:3.4
-3.35:-1:-3.3
-0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
$Math::BigFloat::rnd_mode = '-inf'
+4.23:-1:4.2
-4.23:-1:-4.2
@@ -226,10 +226,10 @@ $Math::BigFloat::rnd_mode = '-inf'
+4.35:-1:4.3
-4.35:-1:-4.4
-0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
$Math::BigFloat::rnd_mode = 'odd'
+5.23:-1:5.2
-5.23:-1:-5.2
@@ -240,10 +240,10 @@ $Math::BigFloat::rnd_mode = 'odd'
+5.35:-1:5.3
-5.35:-1:-5.3
-0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
$Math::BigFloat::rnd_mode = 'even'
+6.23:-1:6.2
-6.23:-1:-6.2
@@ -254,10 +254,10 @@ $Math::BigFloat::rnd_mode = 'even'
+6.35:-1:6.4
-6.35:-1:-6.4
-0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
&fcmp
abc:abc:
abc:+0:
diff --git a/t/lib/io_linenum.t b/t/lib/io_linenum.t
index 0d28e1898c..3503215201 100755
--- a/t/lib/io_linenum.t
+++ b/t/lib/io_linenum.t
@@ -1,19 +1,27 @@
#!./perl
-# test added 29th April 1998 by Paul Johnson (pjcj@transeda.com)
+# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
+# updated 28th May 1999 by Paul Johnson
-BEGIN {
- chdir 't' if -d 't';
- unshift @INC, '../lib' if -d '../lib';
+my $File;
+
+BEGIN
+{
+ $File = __FILE__;
+ if (-d 't')
+ {
+ chdir 't';
+ $File =~ s/^t\W+//; # Remove first directory
+ }
+ unshift @INC, '../lib' if -d '../lib';
+ require strict; import strict;
}
-use strict;
-use IO::File;
use Test;
-BEGIN {
- plan tests => 9 #, todo => [10]
-}
+BEGIN { plan tests => 12 }
+
+use IO::File;
sub lineno
{
@@ -21,49 +29,52 @@ sub lineno
my $l;
$l .= "$. ";
$l .= $f->input_line_number;
- $l .= " $.";
+ $l .= " $."; # check $. before and after input_line_number
$l;
}
-sub OK
-{
- my $s = select STDOUT; # work around a bug in Test.pm 1.04
- &ok;
- select $s;
-}
-
my $t;
-open (Q, __FILE__) or die $!;
-my $w = IO::File->new(__FILE__) or die $!;
+open (F, $File) or die $!;
+my $io = IO::File->new($File) or die $!;
+
+<F> for (1 .. 10);
+ok(lineno($io), "10 0 10");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "5 5 5");
-<Q> for (1 .. 10);
-OK(lineno($w), "10 0 10");
+<F>;
+ok(lineno($io), "11 5 11");
-$w->getline for (1 .. 5);
-OK(lineno($w), "5 5 5");
+$io->getline;
+ok(lineno($io), "6 6 6");
-<Q>;
-OK(lineno($w), "11 5 11");
+$t = tell F; # tell F; provokes a warning
+ok(lineno($io), "11 6 11");
-$w->getline;
-OK(lineno($w), "6 6 6");
+<F>;
+ok(lineno($io), "12 6 12");
-$t = tell Q; # tell Q; provokes a warning - the world is full of bugs...
-OK(lineno($w), "11 6 11");
+select F;
+ok(lineno($io), "12 6 12");
-<Q>;
-OK(lineno($w), "12 6 12");
+<F> for (1 .. 10);
+ok(lineno($io), "22 6 22");
-select Q;
-OK(lineno($w), "12 6 12");
+$io->getline for (1 .. 5);
+ok(lineno($io), "11 11 11");
-<Q> for (1 .. 10);
-OK(lineno($w), "22 6 22");
+$t = tell F;
+# We used to have problems here before local $. worked.
+# input_line_number() used to use select and tell. When we did the
+# same, that mechanism broke. It should work now.
+ok(lineno($io), "22 11 22");
+
+{
+ local $.;
+ $io->getline for (1 .. 5);
+ ok(lineno($io), "16 16 16");
+}
-$w->getline for (1 .. 5);
-OK(lineno($w), "11 11 11");
-__END__
-# This test doesn't work. It probably won't until local $. does.
-$t = tell Q;
-OK(lineno($w), "22 11 22", 'waiting for local $.');
+ok(lineno($io), "22 16 22");
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index e236f5f399..782f2554c8 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -134,7 +134,7 @@ if($pid = fork()) {
}
# some machines seem to suffer from a race condition here
- sleep(1);
+ sleep(2);
$sock = IO::Socket::INET->new("127.0.0.1:$port");
if ($sock) {
diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index 7a4556d215..e1c89c4ebd 100644
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -21,6 +21,13 @@ BEGIN {
elsif ($Config{'extensions'} !~ /\bIO\b/) {
$reason = 'IO extension unavailable';
}
+ elsif ($^O eq 'os2') {
+ use IO::Socket;
+
+ eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+ or $@ !~ /not implemented/ or
+ $reason = 'compiled without TCP/IP stack v4';
+ }
undef $reason if $^O eq 'VMS' and $Config{d_socket};
if ($reason) {
print "1..0 # Skip: $reason\n";
@@ -32,12 +39,12 @@ BEGIN {
$PATH = "/tmp/sock-$$";
# Test if we can create the file within the tmp directory
-if (-e $PATH or not open(TEST, ">$PATH")) {
- print "1..0\n";
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+ print "1..0 # Skip: cannot open '$PATH' for write\n";
exit 0;
}
close(TEST);
-unlink($PATH) or die "Can't unlink $PATH: $!";
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
# Start testing
$| = 1;
@@ -60,7 +67,7 @@ if($pid = fork()) {
$sock->close;
waitpid($pid,0);
- unlink($PATH) || warn "Can't unlink $PATH: $!";
+ unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
print "ok 5\n";
diff --git a/t/op/grent.t b/t/op/grent.t
index 9b06f11a3e..c9d3797533 100755
--- a/t/op/grent.t
+++ b/t/op/grent.t
@@ -3,6 +3,11 @@
BEGIN {
chdir 't' if -d 't';
unshift @INC, "../lib" if -d "../lib";
+ eval {my @n = getgrgid 0};
+ if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+ print "1..0 # Skip: $1\n";
+ exit 0;
+ }
eval { require Config; import Config; };
my $reason;
if ($Config{'i_grp'} ne 'define') {
diff --git a/t/op/groups.t b/t/op/groups.t
index d22d8f07ad..f46af93bd3 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -65,6 +65,11 @@ EOM
quit();
}
+unless (eval { getgrgid(0); 1 }) {
+ print "1..0 # Skip: getgrgid() not implemented\n";
+ exit 0;
+}
+
# Remember that group names can contain whitespace, '-', et cetera.
# That is: do not \w, do not \S.
if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
diff --git a/t/op/pwent.t b/t/op/pwent.t
index feee6f2b90..788d2f2701 100755
--- a/t/op/pwent.t
+++ b/t/op/pwent.t
@@ -3,6 +3,11 @@
BEGIN {
chdir 't' if -d 't';
unshift @INC, "../lib" if -d "../lib";
+ eval {my @n = getpwuid 0};
+ if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+ print "1..0 # Skip: $1\n";
+ exit 0;
+ }
eval { require Config; import Config; };
my $reason;
if ($Config{'i_pwd'} ne 'define') {
diff --git a/t/op/stat.t b/t/op/stat.t
index ae627f6070..60c70f2bb7 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -19,23 +19,34 @@ chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
$DEV = `ls -l /dev` unless $Is_Dosish;
unlink "Op.stat.tmp";
-open(FOO, ">Op.stat.tmp");
-
-# hack to make Apollo update link count:
-$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat(FOO);
-if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
-if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {print "ok 2\n";}
-else {print "# |$mtime| vs |$ctime|\nnot ok 2\n";}
-
-print FOO "Now is the time for all good men to come to.\n";
-close(FOO);
-
-sleep 2;
+if (open(FOO, ">Op.stat.tmp")) {
+ # hack to make Apollo update link count:
+ $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
+
+ ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat(FOO);
+ if ($nlink == 1) {
+ print "ok 1\n";
+ }
+ else {
+ print "# res=$res, nlink=$nlink.\nnot ok 1\n";
+ }
+ if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {
+ print "ok 2\n";
+ }
+ else {
+ print "# |$mtime| vs |$ctime|\nnot ok 2\n";
+ }
+
+ print FOO "Now is the time for all good men to come to.\n";
+ close(FOO);
+
+ sleep 2;
+} else {
+ print "# open failed: $!\nnot ok 1\nnot ok 2\n";
+}
-if ($Is_Dosish) { unlink "Op.stat.tmp2" }
+if ($Is_Dosish) { unlink "Op.stat.tmp2"}
else {
`rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
}
@@ -65,7 +76,7 @@ else {
}
print "#4 :$mtime: should != :$ctime:\n";
-unlink "Op.stat.tmp";
+unlink "Op.stat.tmp" or print "# unlink failed: $!\n";
if ($Is_MSWin32) { open F, '>Op.stat.tmp' and close F }
else { `touch Op.stat.tmp` }
@@ -76,7 +87,7 @@ $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
$olduid = $>; # can't test -r if uid == 0
$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
chmod 0,'Op.stat.tmp';
@@ -95,7 +106,7 @@ foreach ((12,13,14,15,16,17)) {
# in ms windows, Op.stat.tmp inherits owner uid from directory
# not sure about os/2, but chown is harmless anyway
-chown $>,'Op.stat.tmp';
+eval { chown $>,'Op.stat.tmp'; 1 } or print "# $@" ;
chmod 0700,'Op.stat.tmp';
if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
@@ -261,4 +272,4 @@ $_ = 'Op.stat.tmp';
if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index b0202f7fdf..c72534a15f 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -87,6 +87,16 @@
(Maybe you meant system() when you said exec()?
exec "true" ; my $a
+ defined(@array) is deprecated (and not really meaningful)
+ (Maybe you should just omit the defined()?)
+ defined @a ;
+ my @a ; defined @a ;
+ defined (@a = (1,2,3)) ;
+
+ defined(%hash) is deprecated (and not really meaningful)
+ (Maybe you should just omit the defined()?)
+ defined %h ;
+ my %h ; defined %h ;
__END__
# op.c
@@ -543,3 +553,38 @@ my $a
EXPECT
Statement unlikely to be reached at - line 4.
(Maybe you meant system() when you said exec()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(@a);
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+my @a; defined(@a);
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(@a = (1,2,3));
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(%h);
+EXPECT
+defined(%hash) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+my %h; defined(%h);
+EXPECT
+defined(%hash) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
diff --git a/util.c b/util.c
index 1fcc82b2ec..24f857e6db 100644
--- a/util.c
+++ b/util.c
@@ -2087,6 +2087,7 @@ my_popen(char *cmd, char *mode)
PerlLIO_dup2(p[THIS], *mode == 'r');
PerlLIO_close(p[THIS]);
}
+#ifndef OS2
if (doexec) {
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
int fd;
@@ -2101,6 +2102,7 @@ my_popen(char *cmd, char *mode)
do_exec3(cmd,pp[1],did_pipes); /* may or may not use the shell */
PerlProc__exit(1);
}
+#endif /* defined OS2 */
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
sv_setiv(GvSV(tmpgv), (IV)getpid());
@@ -3197,12 +3199,6 @@ get_opargs(void)
return PL_opargs;
}
-SV **
-get_specialsv_list(void)
-{
- return PL_specialsv_list;
-}
-
#ifndef HAS_GETENV_LEN
char *
getenv_len(char *env_elem, unsigned long *len)
@@ -3323,29 +3319,36 @@ I32
my_fflush_all(void)
{
#ifdef FFLUSH_NULL
- return fflush(NULL);
+ return PerlIO_flush(NULL);
#else
long open_max = -1;
# if defined(FFLUSH_ALL) && defined(HAS_STDIO_STREAM_ARRAY)
+# 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;
+ open_max = FOPEN_MAX;
# else
# ifdef OPEN_MAX
-# open_max = OPEN_MAX;
+ open_max = OPEN_MAX;
# else
# ifdef _NFILE
-# open_max = _NFILE;
+ open_max = _NFILE;
# endif
# endif
# endif
# endif
+# endif
if (open_max > 0) {
long i;
for (i = 0; i < open_max; i++)
- fflush(&STDIO_STREAM_ARRAY[i]);
+ if (STDIO_STREAM_ARRAY[i]._file >= 0 &&
+ STDIO_STREAM_ARRAY[i]._file < open_max &&
+ STDIO_STREAM_ARRAY[i]._flag)
+ PerlIO_flush(&STDIO_STREAM_ARRAY[i]);
return 0;
}
# endif
diff --git a/utils/Makefile b/utils/Makefile
index b650bbdca1..5f424e308f 100644
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -5,9 +5,9 @@ REALPERL = ../perl
# Files to be built with variable substitution after miniperl is
# available. Dependencies handled manually below (for now).
-pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL perlbc.PL
-plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc perlbc
-plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe perlbc.exe
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL
+plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc
+plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe
all: $(plextract)
@@ -33,8 +33,6 @@ splain: splain.PL ../config.sh ../lib/diagnostics.pm
perlcc: perlcc.PL ../config.sh
-perlbc: perlbc.PL ../config.sh
-
clean:
realclean:
View Lorry Controller Status