releases.)
----------------
+Version 5.003_10
+----------------
+
+This patch is closing in on 5.004. It contains lots of small and
+valuable changes, but nothing dramatic.
+
+ CORE LANGUAGE CHANGES
+
+ Title: "Allow &{sub {...}} without warning"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: toke.c
+
+ Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} function
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: toke.c
+
+ Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}""
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: toke.c
+
+ OTHER CORE CHANGES
+
+ Title: "Fix regex matching of chars with high bit set"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: regexec.c
+
+ Title: "Hash key memory corruption fix and naming cleanup"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: hv.c hv.h perl.h
+
+ Title: "Undo broken perf. patch (PADTMP stealing)"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: sv.c
+
+ Title: "Make SV unstudied in sv_gets()"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: sv.c
+
+ Title: "Better support for UVs"
+ From: Paul Marquess
+ Files: global.sym old_global.sym perl.h pp.c pp.h proto.h sv.c sv.h
+
+ Title: "Minor locale cleanups"
+ (Accept "POSIX" locale as standard like "C". Reset locale to
+ 'C' when testing strtod() in t/lib/posix.t.)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: t/lib/posix.t util.c
+
+ Title: "Always taint result of sprintf() on float"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: doop.c
+
+ Title: "Fix spurious warning from bitwise string ops"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: doop.c
+
+ Title: "Eliminate warning on {,sys}read(,$newvar,)"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: doop.c pp_sys.c
+
+ Title: "Don't call fcntl(fileno(rsfp)) if !rsfp"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: perl.c
+
+ Title: "Save message when calling __DIE__ hook"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp_ctl.c
+
+ Title: "Namespace cleanup"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: global.sym old_global.sym perl.h
+
+ Title: "Modify perl_exp.SH; create old_perl_exp.SH; document old_*"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH
+
+ PORTABILITY
+
+ Title: "Reliable signal patch"
+ From: Kenneth Albanowski <kjahds@kjahds.com>
+ Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com>
+ Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST)
+ Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c
+
+ Title: "Emulate missing flock() with either fcntl() or lockf()"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp_sys.c
+
+ Title: "3_09: minor patches for OS/2"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199611270830.DAA04985@monk.mps.ohio-state.edu>
+ Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST)
+ Files: doio.c global.sym malloc.c old_global.sym os2/Makefile.SHs
+ os2/OS2/ExtAttr/Makefile.PL os2/OS2/PrfDB/Makefile.PL
+ os2/OS2/Process/Makefile.PL os2/OS2/REXX/Makefile.PL
+ os2/os2.c os2/os2ish.h perl.h
+
+ Title: "Re: 5.003_09 and QNX"
+ From: nort@bottesini.harvard.edu (Norton Allen)
+ Msg-ID: <9611271836.AA14460@bottesini.harvard.edu>
+ Date: Wed, 27 Nov 96 13:36:06 est
+ Files: Configure MANIFEST README.qnx hints/qnx.sh qnx/ar qnx/cpp
+ t/TEST toke.c util.c x2p/proto.h
+
+ Title: "Re: updated patch on the sysread, syswrite for VMS"
+ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+ Msg-ID: <01ICB648K2XG001A1D@hmivax.humgen.upenn.edu>
+ Date: Tue, 26 Nov 1996 17:28:23 -0500 (EST)
+ Files: t/op/sysio.t
+
+ LIBRARY AND EXTENSIONS
+
+ Title: "Minor patch to debugger"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199611290533.AAA08053@monk.mps.ohio-state.edu>
+ Date: Fri, 29 Nov 1996 00:33:49 -0500 (EST)
+ Files: lib/perl5db.pl
+
+ Title: "AutoLoader::AUTOLOAD optimization"
+ From: nick@ni-s.u-net.com (Nick Ing-Simmons)
+ Msg-ID: <199611231954.TAA09921@ni-s.u-net.com>
+ Date: Sat, 23 Nov 1996 19:54:52 GMT
+ Files: lib/AutoLoader.pm
+
+ Title: "Diagnostic cleanup"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: lib/diagnostics.pm pod/perldiag.pod
+
+ DOCUMENTATION
+
+ Title: "Improve documentation for sysread() and syswrite()"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pod/perlfunc.pod
+
+ Title: "Document how to use $SIG{ALRM} and alarm()"
+ From: Roderick Schertler <roderick@ibcinc.com>
+ Msg-ID: <5898.849026569@eeyore.ibcinc.com>
+ Date: Tue, 26 Nov 1996 11:42:49 -0500
+ Files: pod/perlfunc.pod
+
+
+----------------
+Version 5.003_09
+----------------
+
+This patch was a compendium of various fixes and enhancements from
+many people, including some serious improvement in lexical variable
+scoping and locale handling.
+
+ CORE LANGUAGE CHANGES
+
+ Title: "Lexical locales"
+ (make effectiveness of locales depend on C<use locale>)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: too many to list
+
+ Title: "Lexical scoping cleanup"
+ (tighten scoping of lexical variables, somewhat on the
+ new constructs and somewhat on the old)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: many... but mostly perly.y and toke.c
+
+ Title: "Re: memory corruption / security bug in sysread,syswrite + pa
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Msg-ID: <199611251946.VAA30459@alpha.hut.fi>
+ Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET)
+ Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c
+ t/op/sysio.t
+
+ OTHER CORE CHANGES
+
+ Title: "Configure fix for handling DynaLoader"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: Configure
+
+ Title: "Properly prototype safe{malloc,calloc,realloc,free}."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: proto.h
+
+ Title: "UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1,
+ From: John Hughes <john@AtlanTech.COM>
+ Msg-ID: <01BBD6EE.E915C860@malvinas.AtlanTech.COM>
+ Date: Wed, 20 Nov 1996 14:27:06 +0100
+ Files: sv.c
+
+ Title: ""static" call to UNIVERSAL::can"
+ From: Nick.Ing-Simmons@tiuk.ti.com
+ Msg-ID: <199611211547.PAA15878@pluto>
+ Date: Thu, 21 Nov 1996 15:47:46 GMT
+ Files: universal.c
+
+ Title: "die -> croak"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199611212111.QAA17070@aatma.engin.umich.edu>
+ Date: Thu, 21 Nov 1996 16:11:21 -0500
+ Files: pp_ctl.c
+
+ Title: "Patch for embed.pl when !EMBED && !MULTIPLICITY"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: embed.pl
+
+ Title: "Add new symbols to old_global.sym, too."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: global.sym old_global.sym
+
+ Title: "Cleanup of {,un}pack('w')."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp.c
+
+ Title: "Cleanups from Ilya."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c
+
+ Title: "Fix for unpack('w') on 64-bit systems."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp.c
+
+ Title: "Re: LC_NUMERIC support is ready + performance"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199611260308.WAA02677@monk.mps.ohio-state.edu>
+ Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST)
+ Files: sv.c
+
+ Title: "Hash key sharing improvements from Ilya."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: hv.c hv.h proto.h
+
+ Title: "Mortal stack pre-allocation from Ilya."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
+
+ PORTABILITY
+
+ Title: "VMS patches post-5.003_08"
+ From: bailey@hmivax.humgen.upenn.edu (Charles Bailey)
+ Msg-ID: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu>
+ Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST)
+ Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ lib/ExtUtils/MakeMaker.pm lib/File/Path.pm mg.c pp_ctl.c
+ utils/h2xs.PL vms/config.vms vms/descrip.mms
+ vms/gen_shrfls.pl vms/genconfig.pl vms/perlvms.pod vms/vms.c
+ vms/vmsish.h
+
+ Title: "5.003_08: OS/2-specific bugs/enhancements"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199611241147.GAA00490@monk.mps.ohio-state.edu>
+ Date: Sun, 24 Nov 1996 06:47:25 -0500 (EST)
+ Files: README.os2 hints/os2.sh os2/Changes os2/Makefile.SHs
+ os2/OS2/PrfDB/PrfDB.pm os2/os2.c
+
+ Title: "HP patches didn't make it into _08 (fwd)"
+ From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
+ Msg-ID: <199611260215.AA100414526@hpcc123.corp.hp.com>
+ Date: Mon, 25 Nov 96 18:15:26 PST
+ Files: ext/DynaLoader/dl_hpux.xs
+
+ Title: "Another HP "patch" that didn't make it (new hints file)"
+ From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
+ Msg-ID: <199611252116.AA245766577@hpcc123.corp.hp.com>
+ Date: Mon, 25 Nov 1996 13:16:17 -0800
+ Files: hints/hpux.sh
+
+ LIBRARY AND EXTENSIONS
+
+ Title: "Elide spurious space in db-hash.t"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: t/lib/db-hash.t
+
+ Title: "Update documentation and warning in I18N::Collate."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: lib/I18N/Collate.pm
+
+ Title: "Fix bitwise op test; clean up a couple of others"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: t/lib/bigintpm.t t/op/bop.t t/op/overload.t
+
+ Title: "minimal timelocal.pl for _09"
+ From: Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
+ Msg-ID: <9611191854.AA19586@o09.rosat.mpe-garching.mpg.de>
+ Date: Tue, 19 Nov 1996 19:54:23 +0100
+ Files: lib/Time/Local.pm
+
+ Title: "Socket test improvement from Ilya."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: t/lib/io_sock.t
+
+ Title: "Re: blib"
+ From: nick@ni-s.u-net.com (Nick Ing-Simmons)
+ Msg-ID: <199611230917.JAA00471@ni-s.u-net.com>
+ Date: Sat, 23 Nov 1996 09:17:40 GMT
+ Files: lib/blib.pm
+
+ DOCUMENTATION
+
+ Title: "perldiag documentation patch."
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID: <9611201607.AA12729@claudius.bfsec.bt.co.uk>
+ Date: Wed, 20 Nov 96 16:07:28 GMT
+ Files: pod/perldiag.pod
+
+ Title: "a missing perldiag entry"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID: <199611212024.PAA15758@aatma.engin.umich.edu>
+ Date: Thu, 21 Nov 1996 15:24:02 -0500
+ Files: pod/perldiag.pod
+
+ Title: "perlfunc patch"
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID: <9611201404.AA12477@claudius.bfsec.bt.co.uk>
+ Date: Wed, 20 Nov 96 14:04:08 GMT
+ Files: pod/perlfunc.pod
+
+ Title: "Patch for pod/perlpod.pod"
+ From: "Joseph S. Myers" <jsm28@cam.ac.uk>
+ Msg-ID: <Pine.LNX.3.95.961120235016.6666A-100000@hammer.chu.cam.ac.uk
+ Date: Wed, 20 Nov 1996 23:54:41 +0000 (GMT)
+ Files: pod/perlpod.pod
+
+ Title: "Update locale documentation."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pod/perli18n.pod
+
+ BUNDLED UTILITIES
+
+ Title: "Fix type mismatches in x2p's safe{alloc,realloc,free}."
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: x2p/util.c
+
+
+----------------
Version 5.003_08
----------------
CONFIG=true
echo "Doing variable substitutions on .SH files..."
if test -f MANIFEST; then
- shlist=`awk '{print $1}' <MANIFEST | grep '\.SH'`
+ shlist=`awk '!/^old_/ {print $1}' <MANIFEST | grep '\.SH$'`
: Pick up possible extension manifests.
for dir in ext/* ; do
if test -f $dir/MANIFEST; then
- xxx=`awk '{print $1}' < $dir/MANIFEST |
+ xxx=`awk '!/^old_/ {print $1}' < $dir/MANIFEST |
sed -n "/\.SH$/ s@^@$dir/@p"`
shlist="$shlist $xxx"
fi
set x $shlist
else
echo "(Looking for .SH files under the current directory.)"
- set x `find . -name "*.SH" -print`
+ set x `find . -name "*.SH" -print | grep -v '/old_'`
fi
shift
case $# in
uts) osname=uts
osvers="$3"
;;
+ qnx) osname=qnx
+ osvers="$4"
+ ;;
$2) case "$osname" in
*isc*) ;;
*freebsd*) ;;
tarch=`arch`"-$osname"
elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then
if uname -m > tmparch 2>&1 ; then
- tarch=`$sed -e 's/ /_/g' -e 's/$/'"-$osname/" tmparch`
+ tarch=`$sed -e 's/ /_/g' -e 's/_*$//' -e 's/$/'"-$osname/" tmparch`
else
tarch="$osname"
fi
. ./myread
so="$ans"
+: If no lib_ext yet, assume '.a'.
+case "$lib_ext" in
+'') lib_ext='.a';;
+esac
+
: Looking for optional libraries
echo " "
echo "Checking for optional libraries..." >&4
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc lib$thislib.a X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc lib$thislib${lib_ext} X $libpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc $thislib.a X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc $thislib${lib_ext} X $libpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`./loc lib${thislib}_s.a X $libpth`; $test -f "$xxx"; then
+ elif xxx=`./loc lib${thislib}_s${lib_ext} X $libpth`; $test -f "$xxx"; then
echo "Found -l${thislib}_s."
case " $dflt " in
*"-l$thislib "*);;
*) dflt="$dflt -l${thislib}_s";;
esac
- elif xxx=`./loc Slib$thislib.a X $xlibpth`; $test -f "$xxx"; then
+ elif xxx=`./loc Slib$thislib${lib_ext} X $xlibpth`; $test -f "$xxx"; then
echo "Found -l$thislib."
case " $dflt " in
*"-l$thislib "*);;
case "$libc" in
'') libc=unknown
case "$libs" in
- *-lc_s*) libc=`./loc libc_s.a $libc $libpth`
+ *-lc_s*) libc=`./loc libc_s${lib_ext} $libc $libpth`
esac
;;
esac
:
elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then
:
- elif try=`./loc lib$thislib.a X $libpth`; $test -f "$try"; then
+ elif try=`./loc lib$thislib${lib_ext} X $libpth`; $test -f "$try"; then
+ :
+ elif try=`./loc $thislib${lib_ext} X $libpth`; $test -f "$try"; then
:
elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then
:
elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
:
- elif try=`./loc Slib$thislib.a X $xlibpth`; $test -f "$try"; then
+ elif try=`./loc Slib$thislib${lib_ext} X $xlibpth`; $test -f "$try"; then
:
else
try=''
fi
elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then
echo "Your C library seems to be in $libc, as you said before."
-elif $test -r $incpath/usr/lib/libc.a; then
- libc=$incpath/usr/lib/libc.a;
+elif $test -r $incpath/usr/lib/libc${lib_ext}; then
+ libc=$incpath/usr/lib/libc${lib_ext};
echo "Your C library seems to be in $libc. That's fine."
-elif $test -r /lib/libc.a; then
- libc=/lib/libc.a;
+elif $test -r /lib/libc${lib_ext}; then
+ libc=/lib/libc${lib_ext};
echo "Your C library seems to be in $libc. You're normal."
else
- if tans=`./loc libc.a blurfl/dyick $libpth`; $test -r "$tans"; then
+ if tans=`./loc libc${lib_ext} blurfl/dyick $libpth`; $test -r "$tans"; then
:
elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then
libnames="$libnames "`./loc clib blurfl/dyick $libpth`
elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then
:
- elif tans=`./loc Slibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then
+ elif tans=`./loc Slibc${lib_ext} blurfl/dyick $xlibpth`; $test -r "$tans"; then
:
- elif tans=`./loc Mlibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then
+ elif tans=`./loc Mlibc${lib_ext} blurfl/dyick $xlibpth`; $test -r "$tans"; then
:
else
- tans=`./loc Llibc.a blurfl/dyick $xlibpth`
+ tans=`./loc Llibc${lib_ext} blurfl/dyick $xlibpth`
fi
if $test -r "$tans"; then
echo "Your C library seems to be in $tans, of all places."
case "$ar" in
'') ar='ar';;
esac
-case "$lib_ext" in
-'') lib_ext='.a';;
-esac
case "$obj_ext" in
'') obj_ext='.o';;
esac
val="$define"
cryptlib=''
else
- cryptlib=`./loc Slibcrypt.a "" $xlibpth`
+ cryptlib=`./loc Slibcrypt${lib_ext} "" $xlibpth`
if $test -z "$cryptlib"; then
- cryptlib=`./loc Mlibcrypt.a "" $xlibpth`
+ cryptlib=`./loc Mlibcrypt${lib_ext} "" $xlibpth`
else
cryptlib=-lcrypt
fi
if $test -z "$cryptlib"; then
- cryptlib=`./loc Llibcrypt.a "" $xlibpth`
+ cryptlib=`./loc Llibcrypt${lib_ext} "" $xlibpth`
else
cryptlib=-lcrypt
fi
if $test -z "$cryptlib"; then
- cryptlib=`./loc libcrypt.a "" $libpth`
+ cryptlib=`./loc libcrypt${lib_ext} "" $libpth`
else
cryptlib=-lcrypt
fi
: we will have to assume that it supports the 4.2 BSD interface
d_oldsock="$undef"
else
- echo "You don't have Berkeley networking in libc.a..." >&4
- if test -f /usr/lib/libnet.a; then
- ( (nm $nm_opt /usr/lib/libnet.a | eval $nm_extract) || \
- ar t /usr/lib/libnet.a) 2>/dev/null >> libc.list
+ echo "You don't have Berkeley networking in libc${lib_ext}..." >&4
+ if test -f /usr/lib/libnet${lib_ext}; then
+ ( (nm $nm_opt /usr/lib/libnet${lib_ext} | eval $nm_extract) || \
+ ar t /usr/lib/libnet${lib_ext}) 2>/dev/null >> libc.list
if $contains socket libc.list >/dev/null 2>&1; then
echo "...but the Wollongong group seems to have hacked it in." >&4
socketlib="-lnet"
d_oldsock="$define"
fi
else
- echo "or even in libnet.a, which is peculiar." >&4
+ echo "or even in libnet${lib_ext}, which is peculiar." >&4
d_socket="$undef"
d_oldsock="$undef"
fi
$cc $ccflags -c bar1.c >/dev/null 2>&1
$cc $ccflags -c bar2.c >/dev/null 2>&1
$cc $ccflags -c foo.c >/dev/null 2>&1
-ar rc bar.a bar2.o bar1.o >/dev/null 2>&1
-if $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+ar rc bar${lib_ext} bar2.o bar1.o >/dev/null 2>&1
+if $cc $ccflags $ldflags -o foobar foo.o bar${lib_ext} $libs > /dev/null 2>&1 &&
./foobar >/dev/null 2>&1; then
echo "ar appears to generate random libraries itself."
orderlib=false
ranlib=":"
-elif ar ts bar.a >/dev/null 2>&1 &&
- $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+elif ar ts bar${lib_ext} >/dev/null 2>&1 &&
+ $cc $ccflags $ldflags -o foobar foo.o bar${lib_ext} $libs > /dev/null 2>&1 &&
./foobar >/dev/null 2>&1; then
echo "a table of contents needs to be added with 'ar ts'."
orderlib=false
=back
+=head1 Binary Compatibility With 5.003
+
+Perl 5.003 turned on the EMBED feature by default, which tries to
+avoid possible symbol name conflict by prefixing all global symbols
+with "Perl_". However, its list of global symbols was incomplete.
+This error has been rectified in Perl 5.004.
+
+However, some sites may need to maintain complete binary compatibility
+with Perl 5.003. If you are building Perl for such a site, then after
+B<Configure> you should run these two commands:
+
+ perl old_embed.pl
+ sh old_perl_exp.SH
+
+These commands will make your new Perl as binary-compatible with
+version 5.003 as possible.
+
=head1 make depend
This will look for all the includes.
README The Instructions
README.os2 Notes about OS/2 port
README.plan9 Notes about Plan9 port
+README.qnx Notes about QNX port
README.vms Notes about VMS port
Todo The Wishlist
XSUB.h Include file for extension subroutines
hints/next_4.sh Hints for named architecture
hints/opus.sh Hints for named architecture
hints/os2.sh Hints for named architecture
+hints/qnx.sh Hints for named architecture
hints/powerux.sh Hints for named architecture
hints/sco.sh Hints for named architecture
hints/sco_2_3_0.sh Hints for named architecture
nostdio.h Cause compile error on stdio calls
old_embed.pl Produces embed.h using old_global.sym
old_global.sym Old list of symbols to hide when embedded
+old_perl_exp.SH Creates old list of exported symbols for AIX.
op.c Opcode syntax tree code
op.h Opcode syntax tree header
opcode.h Automatically generated opcode header
pp_hot.c Push/Pop code for heavily used opcodes
pp_sys.c Push/Pop code for system interaction
proto.h Prototypes
+qnx/ar QNX implementation of "ar" utility
+qnx/cpp QNX implementation of preprocessor filter
regcomp.c Regular expression compiler
regcomp.h Private declarations for above
regexec.c Regular expression evaluator
universal.c The default UNIVERSAL package methods
unixish.h Defines that are assumed on Unix
util.c Utility routines
-util.h Public declarations for the above
+util.h Dummy header
utils/Makefile Extract the utility scripts.
utils/c2ph.PL program to translate dbx stabs to perl
utils/h2ph.PL A thing to turn C .h files into perl .ph files
x2p/find2perl.PL A find to perl translator
x2p/hash.c Associative arrays again
x2p/hash.h Public declarations for the above
+x2p/proto.h Dummy header
x2p/s2p.PL Sed to perl translator
x2p/str.c String handling package
x2p/str.h Public declarations for the above
done
rm -f perl suidperl miniperl $(LIBPERL)
-realclean: clean
+realclean: clean _cleaner
+ @echo "Note that make realclean does not delete config.sh"
+
+clobber: clean _cleaner
+ rm -f config.sh cppstdin
+
+distclean: clobber
+
+# Do not 'make _cleaner' directly.
+_cleaner:
-cd os2; rm -f Makefile
-cd pod; $(MAKE) realclean
-cd utils; $(MAKE) realclean
rm -f lib/.exists
rm -f h2ph.man pstruct
rm -rf .config
- @echo "Note that make realclean does not delete config.sh"
-
-clobber: realclean
- rm -f config.sh cppstdin
-
-distclean: clobber
# The following lint has practically everything turned on. Unfortunately,
# you have to wade through a lot of mumbo jumbo that can't be suppressed.
--- /dev/null
+README.qnx
+
+Please see hints/qnx.sh for more detailed information about compiling
+perl under QNX4.
+
+The files in the "qnx" directory are:
+
+ * "qnx/ar" is a script that emulates the standard unix archive (aka
+ library) utility. Under Watcom 10.6, ar is linked to wlib and
+ provides the expected interface. With Watcom 9.5, a cover function
+ is required. This one is fairly crude but has proved adequate for
+ compiling perl. A more thorough version is available at:
+
+ http://www.fdma.com/pub/qnx/porting/ar
+
+ * "qnx/cpp" is a script that provides C preprocessing functionality.
+ Configure can generate a similar cover, but it doesn't handle all
+ the command-line options that perl throws at it. This might be
+ reasonably placed in /usr/local/bin.
+
+--
+Norton T. Allen (allen@huarp.harvard.edu)
break;
}
doshell:
- execl(SH_PATH, "sh", "-c", cmd, (char*)0);
+ execl(sh_path, "sh", "-c", cmd, (char*)0);
return FALSE;
}
}
(void)sprintf(xs,f,SvNV(arg));
xlen = strlen(xs);
#ifdef LC_NUMERIC
- /* User-defined locales may include arbitrary characters */
- if (! numeric_standard)
+ /*
+ * User-defined locales may include arbitrary characters.
+ * And, unfortunately, some system may alloc the "C" locale
+ * to be overridden by a malicious user.
+ */
+ if (op->op_type == OP_SPRINTF)
SvTAINTED_on(sv);
-#endif
+#endif /* LC_NUMERIC */
break;
case 's':
ch = *(++t);
char *lsave = lc;
char *rsave = rc;
- dc = SvPV_force(sv,na);
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
- if (SvCUR(sv) < len) {
- dc = SvGROW(sv,len + 1);
- (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+ if (SvOK(sv)) {
+ dc = SvPV_force(sv, na);
+ if (SvCUR(sv) < len) {
+ dc = SvGROW(sv, len + 1);
+ (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+ }
+ }
+ else {
+ I32 needlen = ((optype == OP_BIT_AND)
+ ? len : (leftlen > rightlen ? leftlen : rightlen));
+ Newz(801, dc, needlen + 1, char);
+ (void)sv_usepvn(sv, dc, needlen);
+ dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
}
SvCUR_set(sv, len);
(void)SvPOK_only(sv);
#define seq_amg Perl_seq_amg
#define sge_amg Perl_sge_amg
#define sgt_amg Perl_sgt_amg
+#define sh_path Perl_sh_path
#define sig_name Perl_sig_name
#define sig_num Perl_sig_num
#define sighandler Perl_sighandler
#define yytable Perl_yytable
#define yyval Perl_yyval
#define Gv_AMupdate Perl_Gv_AMupdate
+#define SvTRUE Perl_SvTRUE
+#define SvIV Perl_SvIV
+#define SvUV Perl_SvUV
+#define SvNV Perl_SvNV
#define amagic_call Perl_amagic_call
#define append_elem Perl_append_elem
#define append_list Perl_append_list
#define regprop Perl_regprop
#define repeatcpy Perl_repeatcpy
#define rninstr Perl_rninstr
+#define rsignal Perl_rsignal
+#define rsignal_save Perl_rsignal_save
+#define rsignal_state Perl_rsignal_state
+#define rsignal_restore Perl_rsignal_restore
#define runops Perl_runops
#define safecalloc Perl_safecalloc
#define safemalloc Perl_safemalloc
#define screaminstr Perl_screaminstr
#define setdefout Perl_setdefout
#define setenv_getix Perl_setenv_getix
+#define share_hek Perl_share_hek
#define sharepvn Perl_sharepvn
#define sighandler Perl_sighandler
#define skipspace Perl_skipspace
#define sv_2mortal Perl_sv_2mortal
#define sv_2nv Perl_sv_2nv
#define sv_2pv Perl_sv_2pv
+#define sv_2uv Perl_sv_2uv
#define sv_add_arena Perl_sv_add_arena
#define sv_backoff Perl_sv_backoff
#define sv_bless Perl_sv_bless
#define sv_newmortal Perl_sv_newmortal
#define sv_newref Perl_sv_newref
#define sv_peek Perl_sv_peek
+#define sv_pvn Perl_sv_pvn
#define sv_pvn_force Perl_sv_pvn_force
#define sv_ref Perl_sv_ref
#define sv_reftype Perl_sv_reftype
#define too_few_arguments Perl_too_few_arguments
#define too_many_arguments Perl_too_many_arguments
#define unlnk Perl_unlnk
+#define unshare_hek Perl_unshare_hek
#define unsharepvn Perl_unsharepvn
#define utilize Perl_utilize
#define wait4pid Perl_wait4pid
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-# last modified 10th Nov 1996
-# version 1.05
+# last modified 27th Nov 1996
+# version 1.06
package DB_File::HASHINFO ;
use Carp;
-$VERSION = "1.05" ;
+$VERSION = "1.06" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
Added logic to F<DB_File.xs> to allow the module to be built after Perl
is installed.
+=item 1.06
+
+Minor namespace cleanup: Localized C<PrintBtree>.
+
=back
=head1 BUGS
DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 10th Nov 1996
- version 1.05
+ last modified 27th Nov 1996
+ version 1.06
All comments/suggestions/problems are welcome
Dave Hammen, hammen@gothamcity.jsc.nasa.gov
1.05 - Added logic to allow prefix & hash types to be specified via
Makefile.PL
+ 1.06 - Minor namespace cleanup: Localized PrintBtree.
*/
printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ;
}
+static void
PrintBtree(btree)
BTREEINFO * btree ;
{
#if defined(I_TERMIOS)
#include <termios.h>
#endif
-#include <stdio.h>
#ifdef I_STDLIB
#include <stdlib.h>
#endif
extern long sdbm_hash proto((char *, int));
#ifndef SDBM_ONLY
-#define dbm_open sdbm_open;
-#define dbm_close sdbm_close;
-#define dbm_fetch sdbm_fetch;
-#define dbm_store sdbm_store;
-#define dbm_delete sdbm_delete;
-#define dbm_firstkey sdbm_firstkey;
-#define dbm_nextkey sdbm_nextkey;
-#define dbm_error sdbm_error;
-#define dbm_clearerr sdbm_clearerr;
+#define dbm_open sdbm_open
+#define dbm_close sdbm_close
+#define dbm_fetch sdbm_fetch
+#define dbm_store sdbm_store
+#define dbm_delete sdbm_delete
+#define dbm_firstkey sdbm_firstkey
+#define dbm_nextkey sdbm_nextkey
+#define dbm_error sdbm_error
+#define dbm_clearerr sdbm_clearerr
#endif
/* Most of the following is stolen from perl.h. */
seq_amg
sge_amg
sgt_amg
+sh_path
sig_name
sig_num
sighandler
# Functions
Gv_AMupdate
+SvTRUE
+SvIV
+SvUV
+SvNV
amagic_call
append_elem
append_list
regprop
repeatcpy
rninstr
+rsignal
+rsignal_save
+rsignal_state
+rsignal_restore
runops
safecalloc
safemalloc
screaminstr
setdefout
setenv_getix
+share_hek
sharepvn
sighandler
skipspace
sv_2mortal
sv_2nv
sv_2pv
+sv_2uv
sv_add_arena
sv_backoff
sv_bless
sv_newmortal
sv_newref
sv_peek
+sv_pvn
sv_pvn_force
sv_ref
sv_reftype
too_few_arguments
too_many_arguments
unlnk
+unshare_hek
unsharepvn
utilize
wait4pid
# define U32_MIN PERL_ULONG_MIN
#endif
-#define Ctl(ch) (ch & 037)
+#define Ctl(ch) ((ch) & 037)
#define strNE(s1,s2) (strcmp(s1,s2))
#define strEQ(s1,s2) (!strcmp(s1,s2))
#ifdef USE_NEXT_CTYPE
# define isALNUM_LC(c) \
- (NXIsAlpha((unsigned int)c) || NXIsDigit((unsigned int)c) || c == '_')
-# define isIDFIRST_LC(c) (NXIsAlpha((unsigned int)c) || c == '_')
-# define isALPHA_LC(c) NXIsAlpha((unsigned int)c)
-# define isSPACE_LC(c) NXIsSpace((unsigned int)c)
-# define isDIGIT_LC(c) NXIsDigit((unsigned int)c)
-# define isUPPER_LC(c) NXIsUpper((unsigned int)c)
-# define isLOWER_LC(c) NXIsLower((unsigned int)c)
-# define isPRINT_LC(c) NXIsPrint((unsigned int)c)
-# define toUPPER_LC(c) NXToUpper((unsigned int)c)
-# define toLOWER_LC(c) NXToLower((unsigned int)c)
+ (NXIsAlpha((unsigned int)(c)) || NXIsDigit((unsigned int)(c)) || \
+ (char)(c) == '_')
+# define isIDFIRST_LC(c) \
+ (NXIsAlpha((unsigned int)(c)) || (char)(c) == '_')
+# define isALPHA_LC(c) NXIsAlpha((unsigned int)(c))
+# define isSPACE_LC(c) NXIsSpace((unsigned int)(c))
+# define isDIGIT_LC(c) NXIsDigit((unsigned int)(c))
+# define isUPPER_LC(c) NXIsUpper((unsigned int)(c))
+# define isLOWER_LC(c) NXIsLower((unsigned int)(c))
+# define isPRINT_LC(c) NXIsPrint((unsigned int)(c))
+# define toUPPER_LC(c) NXToUpper((unsigned int)(c))
+# define toLOWER_LC(c) NXToLower((unsigned int)(c))
#else /* !USE_NEXT_CTYPE */
# if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
# define isALNUM_LC(c) \
(isalpha((unsigned char)(c)) || \
- isdigit((unsigned char)(c)) || c == '_')
-# define isIDFIRST_LC(c) (isalpha((unsigned char)(c)) || (c) == '_')
+ isdigit((unsigned char)(c)) || (char)(c) == '_')
+# define isIDFIRST_LC(c) (isalpha((unsigned char)(c)) || (char)(c) == '_')
# define isALPHA_LC(c) isalpha((unsigned char)(c))
# define isSPACE_LC(c) isspace((unsigned char)(c))
# define isDIGIT_LC(c) isdigit((unsigned char)(c))
# else
# define isALNUM_LC(c) \
- (isascii(c) && (isalpha(c) || isdigit(c) || c == '_'))
+ (isascii(c) && (isalpha(c) || isdigit(c) || (c) == '_'))
# define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_'))
# define isALPHA_LC(c) (isascii(c) && isalpha(c))
# define isSPACE_LC(c) (isascii(c) && isspace(c))
#ifndef lint
#ifndef LEAKTEST
-#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
-#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
- memzero((char*)(v), (n) * sizeof(t))
-#define Renew(v,n,t) (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Renewc(v,n,t,c) (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safefree((Malloc_t)(d))
-#define NEWSV(x,len) newSV(len)
+#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
+#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
+ memzero((char*)(v), (n)*sizeof(t))
+#define Renew(v,n,t) \
+ (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) \
+ (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Safefree(d) safefree((Malloc_t)(d))
+#define NEWSV(x,len) newSV(len)
#else /* LEAKTEST */
-#define New(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
-#define Newc(x,v,n,t,c) (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
- memzero((char*)(v), (n) * sizeof(t))
-#define Renew(v,n,t) (v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Renewc(v,n,t,c) (v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safexfree((Malloc_t)d)
-#define NEWSV(x,len) newSV(x,len)
+#define New(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t))))
+#define Newc(x,v,n,t,c) (v = (c*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))), \
+ memzero((char*)(v), (n)*sizeof(t))
+#define Renew(v,n,t) \
+ (v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) \
+ (v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Safefree(d) safexfree((Malloc_t)d)
+#define NEWSV(x,len) newSV(x,len)
+
#define MAXXCOUNT 1200
long xcount[MAXXCOUNT];
long lastxcount[MAXXCOUNT];
#endif /* LEAKTEST */
-#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
#else /* lint */
-#define New(x,v,n,s) (v = Null(s *))
-#define Newc(x,v,n,s,c) (v = Null(s *))
-#define Newz(x,v,n,s) (v = Null(s *))
-#define Renew(v,n,s) (v = Null(s *))
+#define New(x,v,n,s) (v = Null(s *))
+#define Newc(x,v,n,s,c) (v = Null(s *))
+#define Newz(x,v,n,s) (v = Null(s *))
+#define Renew(v,n,s) (v = Null(s *))
#define Move(s,d,n,t)
#define Copy(s,d,n,t)
#define Zero(d,n,t)
-#define Safefree(d) d = d
+#define Safefree(d) (d) = (d)
#endif /* lint */
#ifdef USE_STRUCT_COPY
-#define StructCopy(s,d,t) *((t*)(d)) = *((t*)(s))
+#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
#else
#define StructCopy(s,d,t) Copy(s,d,1,t)
#endif
--- /dev/null
+#----------------------------------------------------------------
+# QNX hints
+#
+# As of perl5.003_09, perl5 will compile without errors
+# and pass almost all the tests in the test suite. The remaining
+# failures have been identified as bugs in the Watcom libraries
+# which I hope will be fixed in the near future.
+#
+# As with many unix ports, this one depends on a few "standard"
+# unix utilities which are not necessarily standard for QNX.
+#
+# /bin/sh This is used heavily by Configure and then by
+# perl itself. QNX's version is fine, but Configure
+# will choke on the 16-bit version, so if you are
+# running QNX 4.22, link /bin/sh to /bin32/ksh
+# ar This is the standard unix library builder.
+# We use wlib. With Watcom 10.6, when wlib is
+# linked as "ar", it behaves like ar and all is
+# fine. Under 9.5, a cover is required. One is
+# included in ../qnx
+# nm This is used (optionally) by configure to list
+# the contents of libraries. I will generate
+# a cover function on the fly in the UU directory.
+# cpp Configure and perl need a way to invoke a C
+# preprocessor. I have created a simple cover
+# for cc which does the right thing. Without this,
+# Configure will create it's own wrapper which works,
+# but it doesn't handle some of the command line arguments
+# that perl will throw at it.
+# make You really need GNU make to compile this. GNU make
+# ships by default with QNX 4.23, but you can get it
+# from quics for earlier versions.
+#----------------------------------------------------------------
+# Outstanding Issues:
+# lib/posix.t test fails on test 17 because acos(1) != 0.
+# Watcom promises to fix this in next release.
+# lib/io_udp.t test hangs because of a bug in getsockname().
+# Fixed in latest BETA socket3r.lib
+# If there is a softlink in your path, Findbin will fail.
+# This is a documented feature of getpwd().
+# There is currently no support for dynamically linked
+# libraries.
+#----------------------------------------------------------------
+# At present, all QNX systems are equivalent architectures,
+# so it might be reasonable to call archname=qnx rather than
+# making an unnecessary distinction between AT-qnx and PCI-qnx,
+# for example.
+#----------------------------------------------------------------
+# These hints were submitted by:
+# Norton T. Allen
+# Harvard University Atmospheric Research Project
+# allen@huarp.harvard.edu
+#
+# If you have suggestions or changes, please let me know.
+#----------------------------------------------------------------
+
+#----------------------------------------------------------------
+# QNX doesn't come with a csh and the ports of tcsh I've used
+# don't work reliably:
+#----------------------------------------------------------------
+csh=''
+d_csh='undef'
+full_csh=''
+
+#----------------------------------------------------------------
+# difftime is implemented as a preprocessor macro, so it doesn't show
+# up in the libraries:
+#----------------------------------------------------------------
+d_difftime='define'
+
+#----------------------------------------------------------------
+# strtod is in the math library, but we can't tell Configure
+# about the math library or it will confuse the linker
+#----------------------------------------------------------------
+d_strtod='define'
+
+#----------------------------------------------------------------
+# The following exist in the libraries, but there are no
+# prototypes available:
+#----------------------------------------------------------------
+d_setregid='undef'
+d_setreuid='undef'
+d_setlinebuf='undef'
+d_truncate='undef'
+d_getpgid='undef'
+
+lib_ext='3r.lib'
+libc='/usr/lib/clib3r.lib'
+
+#----------------------------------------------------------------
+# ccflags:
+# I like to turn the warnings up high, but a few common
+# constructs make a lot of noise, so I turn those warnings off.
+# A few still remain...
+#
+# HIDEMYMALLOC is necessary if using mymalloc since it is very
+# tricky (though not impossible) to totally replace the watcom
+# malloc/free set.
+#
+# unix.h is required as a general rule for unixy applications.
+#----------------------------------------------------------------
+ccflags='-DHIDEMYMALLOC -mf -w4 -Wc,-wcd=202 -Wc,-wcd=203 -Wc,-wcd=302 -Wc,-fi=unix.h'
+
+#----------------------------------------------------------------
+# ldflags:
+# If you want debugging information, you must specify -g on the
+# link as well as the compile. If optimize != -g, you should
+# remove this.
+#----------------------------------------------------------------
+ldflags="-g"
+
+so='none'
+selecttype='fd_set *'
+
+#----------------------------------------------------------------
+# Add -lunix to list of libs. This is needed mainly so the nm
+# search will find funcs in the unix lib. Including unix.h should
+# automatically include the library without -l.
+#----------------------------------------------------------------
+libswanted="$libswanted unix"
+
+if [ -z "`which ar 2>/dev/null`" ]; then
+ cat <<-'EOF'
+ I don't see an 'ar', so I'm guessing you are running
+ Watcom 9.5 or earlier. You may want to install the ar
+ cover found in the qnx subdirectory of this distribution.
+ It might reasonably be placed in /usr/local/bin.
+
+ EOF
+fi
+#----------------------------------------------------------------
+# Here is a nm script which fixes up wlib's output to look
+# something like nm's, at least enough so that Configure can
+# use it.
+#----------------------------------------------------------------
+if [ -z "`which nm 2>/dev/null`" ]; then
+ cat <<-EOF
+ Creating a quick-and-dirty nm cover for Configure to use:
+
+ EOF
+ cat >../UU/nm <<-'EOF'
+ #! /bin/sh
+ #__USAGE
+ #%C <lib> [<lib> ...]
+ # Designed to mimic Unix's nm utility to list
+ # defined symbols in a library
+ for i in $*; do wlib $i; done |
+ awk '
+ /^ / {
+ for (i = 1; i <= NF; i++) {
+ sub("_$", "", $i)
+ print "000000 T " $i
+ }
+ }'
+ EOF
+ chmod +x ../UU/nm
+fi
+
+cppstdin=`which cpp 2>/dev/null`
+if [ -n "$cppstdin" ]; then
+ cat <<-EOF
+ I found a cpp at $cppstdin and will assume it is a good
+ thing to use. If this proves to be false, there is a
+ thin cover for cpp in the qnx subdirectory of this
+ distribution which you could move into your path.
+ EOF
+ cpprun="$cppstdin"
+else
+ cat <<-EOF
+
+ There is a cpp cover in the qnx subdirectory of this
+ distribution which works a little better than the
+ Configure default. You may wish to copy it to
+ /usr/local/bin or some other suitable location.
+ EOF
+fi
char *k;
register HEK *hek;
- New(54, k, sizeof(U32) + sizeof(I32) + len + 1, char);
+ New(54, k, HEK_BASESIZE + len + 1, char);
hek = (HEK*)k;
- Copy(str, HK_KEY(hek), len, char);
- (HK_KEY(hek))[len] = '\0';
- HK_LEN(hek) = len;
- HK_HASH(hek) = hash;
+ Copy(str, HEK_KEY(hek), len, char);
+ *(HEK_KEY(hek) + len) = '\0';
+ HEK_LEN(hek) = len;
+ HEK_HASH(hek) = hash;
return hek;
}
unshare_hek(hek)
HEK *hek;
{
- unsharepvn(HK_KEY(hek),HK_LEN(hek),HK_HASH(hek));
+ unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
}
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
return 0;
if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
+ char *k;
HEK *hek;
- Newz(74, hek, 1, HEK);
+
+ New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ hek = (HEK*)k;
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
entry = &He;
HeVAL(entry) = sv;
- HeKEY_hk(entry) = hek;
+ HeKEY_hek(entry) = hek;
HeSVKEY_set(entry, keysv);
HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */
return entry;
entry = new_he();
if (HvSHAREKEYS(hv))
- HeKEY_hk(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, klen, hash);
else /* gotta do the real thing */
- HeKEY_hk(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, klen, hash);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
entry = new_he();
if (HvSHAREKEYS(hv))
- HeKEY_hk(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, klen, hash);
else /* gotta do the real thing */
- HeKEY_hk(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, klen, hash);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
SvREFCNT_dec(HeVAL(hent));
if (HeKLEN(hent) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(hent));
- Safefree(HeKEY_hk(hent));
+ Safefree(HeKEY_hek(hent));
} else if (shared)
- unshare_hek(HeKEY_hk(hent));
+ unshare_hek(HeKEY_hek(hent));
else
- Safefree(HeKEY_hk(hent));
+ Safefree(HeKEY_hek(hent));
del_he(hent);
}
sv_2mortal(HeVAL(hent)); /* free between statements */
if (HeKLEN(hent) == HEf_SVKEY) {
sv_2mortal(HeKEY_sv(hent));
- Safefree(HeKEY_hk(hent));
+ Safefree(HeKEY_hek(hent));
} else if (shared)
- unshare_hek(HeKEY_hk(hent));
+ unshare_hek(HeKEY_hek(hent));
else
- Safefree(HeKEY_hk(hent));
+ Safefree(HeKEY_hek(hent));
del_he(hent);
}
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
}
else {
+ char *k;
HEK *hek;
- xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */
+
+ xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
Zero(entry, 1, HE);
- Newz(74, hek, 1, HEK);
- HeKEY_hk(entry) = hek;
+ Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ hek = (HEK*)k;
+ HeKEY_hek(entry) = hek;
HeKLEN(entry) = HEf_SVKEY;
}
magic_nextpack((SV*) hv,mg,key);
}
if (HeVAL(entry))
SvREFCNT_dec(HeVAL(entry));
- Safefree(HeKEY_hk(entry));
+ Safefree(HeKEY_hek(entry));
del_he(entry);
xhv->xhv_eiter = Null(HE*);
return Null(HE*);
I32 len;
U32 hash;
{
- return share_hek(sv, len, hash)->hk_key;
+ return HEK_KEY(share_hek(sv, len, hash));
}
/* possibly free a shared string if no one has access to it
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--;
- Safefree(HeKEY_hk(entry));
+ Safefree(HeKEY_hek(entry));
del_he(entry);
--xhv->xhv_keys;
}
}
if (!found) {
entry = new_he();
- HeKEY_hk(entry) = save_hek(str, len, hash);
+ HeKEY_hek(entry) = save_hek(str, len, hash);
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
}
++HeVAL(entry); /* use value slot as REFCNT */
- return HeKEY_hk(entry);
+ return HeKEY_hek(entry);
}
*/
typedef struct he HE;
-typedef struct he_key HEK;
+typedef struct hek HEK;
struct he {
HE *hent_next;
- HEK *hent_hk;
+ HEK *hent_hek;
SV *hent_val;
};
-struct he_key {
- U32 hk_hash;
- I32 hk_len;
- char hk_key[1];
+struct hek {
+ U32 hek_hash;
+ I32 hek_len;
+ char hek_key[1];
};
struct xpvhv {
#define Nullhe Null(HE*)
#define HeNEXT(he) (he)->hent_next
-#define HeKEY_hk(he) (he)->hent_hk
-#define HeKEY(he) HK_KEY(HeKEY_hk(he))
+#define HeKEY_hek(he) (he)->hent_hek
+#define HeKEY(he) HEK_KEY(HeKEY_hek(he))
#define HeKEY_sv(he) (*(SV**)HeKEY(he))
-#define HeKLEN(he) HK_LEN(HeKEY_hk(he))
+#define HeKLEN(he) HEK_LEN(HeKEY_hek(he))
#define HeVAL(he) (he)->hent_val
-#define HeHASH(he) HK_HASH(HeKEY_hk(he))
+#define HeHASH(he) HEK_HASH(HeKEY_hek(he))
#define HePV(he) ((HeKLEN(he) == HEf_SVKEY) ? \
SvPV(HeKEY_sv(he),na) : \
HeKEY(he))
&sv_undef)
#define HeSVKEY_set(he,sv) (HeKEY_sv(he) = sv)
-#define HK_LEN(hk) (hk)->hk_len
-#define HK_KEY(hk) (hk)->hk_key
-#define HK_HASH(hk) (hk)->hk_hash
+#define Nullhek Null(HEK*)
+#define HEK_BASESIZE OFFSETOF(HEK, hek_key)
+#define HEK_HASH(hek) (hek)->hek_hash
+#define HEK_LEN(hek) (hek)->hek_len
+#define HEK_KEY(hek) (hek)->hek_key
}
sub perl_inc {
- print " -I$Config{archlib}/CORE ";
+ print " -I$Config{archlibexp}/CORE ";
}
sub ccopts {
=cut
# Global Constants
-$XSUBPP_version = "1.939";
+$XSUBPP_version = "1.940";
require 5.002;
use vars '$cplusplus';
SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
$flag = shift @ARGV;
$flag =~ s/^-// ;
- $spat = shift, next SWITCH if $flag eq 's';
+ $spat = quotemeta shift, next SWITCH if $flag eq 's';
$cplusplus = 1, next SWITCH if $flag eq 'C++';
$WantPrototypes = 0, next SWITCH if $flag eq 'noprototypes';
$WantPrototypes = 1, next SWITCH if $flag eq 'prototypes';
$Module = $1;
$Package = defined($2) ? $2 : ''; # keep -w happy
$Prefix = defined($3) ? $3 : ''; # keep -w happy
+ $Prefix = quotemeta $Prefix ;
($Module_cname = $Module) =~ s/\W/_/g;
($Packid = $Package) =~ tr/:/_/;
$Packprefix = $Package;
($class, $func_name, $orig_args) = ($1, $2, $3) ;
($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
- $Full_func_name = "${Packid}_$func_name";
+ ($clean_func_name = $func_name) =~ s/^$Prefix//;
+ $Full_func_name = "${Packid}_$clean_func_name";
# Check for duplicate function definition
for $tmp (@XSStack) {
next unless defined $tmp->{functions}{$Full_func_name};
- Warn("Warning: duplicate function definition '$func_name' detected");
+ Warn("Warning: duplicate function definition '$clean_func_name' detected");
last;
}
$XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
# print function header
print Q<<"EOF";
-#XS(XS_${Packid}_$func_name)
+#XS(XS_${Full_func_name})
#[[
# dXSARGS;
EOF
# define MAX_PACKED 6
# define MAX_2_POT_ALGO ((1<<(MAX_PACKED + 1)) - M_OVERHEAD)
# define TWOK_MASK ((1<<11) - 1)
-# define TWOK_MASKED(x) ((int)x & ~TWOK_MASK)
-# define TWOK_SHIFT(x) ((int)x & TWOK_MASK)
+# define TWOK_MASKED(x) ((u_int)(x) & ~TWOK_MASK)
+# define TWOK_SHIFT(x) ((u_int)(x) & TWOK_MASK)
# define OV_INDEXp(block) ((u_char*)(TWOK_MASKED(block)))
# define OV_INDEX(block) (*OV_INDEXp(block))
# define OV_MAGIC(block,bucket) (*(OV_INDEXp(block) + \
/* Got it, now detach SvPV: */
pv = SvPV(sv, na);
/* Check alignment: */
- if ((pv - M_OVERHEAD) & (1<<11 - 1)) {
+ if (((u_int)(pv - M_OVERHEAD)) & ((1<<11) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
return (char *)-1; /* die die die */
}
SvPOK_off(sv);
SvREADONLY_on(sv);
die("Out of memory!"); /* croak may eat too much memory. */
- } else if (emergency_buffer_size >= size) {
+ }
+ else if (emergency_buffer_size >= size) {
emergency_buffer_size -= size;
return emergency_buffer + emergency_buffer_size;
}
op = (union overhead *)sbrk(0);
# ifndef I286
# ifdef PACK_MALLOC
- if ((int)op & 0x7ff)
- (void)sbrk(slack = 2048 - ((int)op & 0x7ff));
+ if ((u_int)op & 0x7ff)
+ (void)sbrk(slack = 2048 - ((u_int)op & 0x7ff));
# else
- if ((int)op & 0x3ff)
- (void)sbrk(slack = 1024 - ((int)op & 0x3ff));
+ if ((u_int)op & 0x3ff)
+ (void)sbrk(slack = 1024 - ((u_int)op & 0x3ff));
# endif
# if defined(DEBUGGING_MSTATS) && defined(PACK_MALLOC)
sbrk_slack += slack;
#endif
op = (union overhead *)sbrk(needed);
/* no more room! */
- if ((int)op == -1 &&
- (int)(op = (union overhead *)emergency_sbrk(size)) == -1)
+ if (op == (union overhead *)-1) {
+ op = (union overhead *)emergency_sbrk(needed);
+ if (op == (union overhead *)-1)
return;
+ }
/*
* Round up to minimum allocation size boundary
* and deduct from block count to reflect.
*/
#ifndef I286
# ifdef PACK_MALLOC
- if ((int)op & 0x7ff)
+ if ((u_int)op & 0x7ff)
croak("panic: Off-page sbrk");
# endif
- if ((int)op & 7) {
+ if ((u_int)op & 7) {
op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
nblks--;
}
return 0;
}
-#ifdef HAS_SIGACTION
-/* set up reliable signal() clone */
-
-typedef void (*Sigfunc) _((int));
-
-static
-Sigfunc rsignal(signo,handler)
-int signo;
-Sigfunc handler;
-{
- struct sigaction act,oact;
-
- act.sa_handler = handler;
- sigemptyset(&act.sa_mask);
- act.sa_flags = 0;
-#ifdef SA_RESTART
- act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
-#endif
- if (sigaction(signo, &act, &oact) < 0)
- return(SIG_ERR);
- else
- return(oact.sa_handler);
-}
-
-#else
-
-/* ah well, so much for reliability */
-
-#define rsignal(x,y) signal(x,y)
-
-#endif
-
-static sig_trapped;
-static
-Signal_t
-sig_trap(signo)
-int signo;
-{
- sig_trapped++;
-}
int
magic_getsig(sv,mg)
SV* sv;
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
else {
- void (*origsig) _((int));
- /* get signal state without losing signals */
- sig_trapped=0;
- origsig = rsignal(i,sig_trap);
- rsignal(i,origsig);
- if(sig_trapped)
- kill(getpid(),i);
+ Sighandler_t sigstate = rsignal_state(i);
+
/* cache state so we don't fetch it again */
- if(origsig == SIG_IGN)
+ if(sigstate == SIG_IGN)
sv_setpv(sv,"IGNORE");
else
sv_setsv(sv,&sv_undef);
}
if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
if (i)
- (void)rsignal(i,sighandler);
+ (void)rsignal(i, sighandler);
else
*svp = SvREFCNT_inc(sv);
return 0;
s = SvPV_force(sv,na);
if (strEQ(s,"IGNORE")) {
if (i)
- (void)rsignal(i,SIG_IGN);
+ (void)rsignal(i, SIG_IGN);
else
*svp = 0;
}
else if (strEQ(s,"DEFAULT") || !*s) {
if (i)
- (void)rsignal(i,SIG_DFL);
+ (void)rsignal(i, SIG_DFL);
else
*svp = 0;
}
sv_setpv(sv,tokenbuf);
}
if (i)
- (void)rsignal(i,sighandler);
+ (void)rsignal(i, sighandler);
else
*svp = SvREFCNT_inc(sv);
}
comppad
comppad_name
comppad_name_fill
-comppad_name_floor
concat_amg
concat_ass_amg
cop_seqmax
curpad
cv_const_sv
dc
-debug
dec_amg
di
div_amg
div_ass_amg
-do_undump
ds
egid
envgv
seq_amg
sge_amg
sgt_amg
+sh_path
sig_name
sig_num
siggv
vtbl_dbline
vtbl_env
vtbl_envelem
+vtbl_fm
vtbl_glob
vtbl_isa
vtbl_isaelem
vtbl_mglob
+vtbl_nkeys
vtbl_pack
vtbl_packelem
vtbl_pos
check_uni
checkcomma
ck_aelem
+ck_bitop
ck_concat
ck_delete
ck_eof
gv_IOadd
gv_check
gv_efullname
+gv_efullname3
gv_fetchfile
gv_fetchmeth
gv_fetchmethod
gv_fetchpv
gv_fullname
+gv_fullname3
gv_init
gv_stashpv
gv_stashpvn
hv_iternext
hv_iternextsv
hv_iterval
+hv_ksplit
hv_magic
hv_stashpv
hv_store
magic_setamagic
magic_setarylen
magic_setbm
+magic_setfm
magic_setcollxfrm
magic_setdbline
magic_setenv
magic_setglob
magic_setisa
magic_setmglob
+magic_setnkeys
magic_setpack
magic_setpos
magic_setsig
magic_wipepack
magicname
markstack_grow
+mem_collxfrm
mess
mg_clear
mg_copy
regprop
repeatcpy
rninstr
+rsignal
+rsignal_save
+rsignal_state
+rsignal_restore
runops
same_dirent
+save_I16
save_I32
save_aptr
save_ary
screaminstr
setdefout
setenv_getix
+share_hek
sharepvn
sighandler
skipspace
sv_2mortal
sv_2nv
sv_2pv
+sv_2uv
sv_add_arena
sv_backoff
sv_bless
sv_cmp_locale
sv_collxfrm
sv_dec
+sv_derived_from
sv_dump
sv_eq
sv_free
sv_setref_pv
sv_setref_pvn
sv_setsv
+sv_setuv
sv_taint
sv_tainted
sv_unmagic
too_few_arguments
too_many_arguments
unlnk
+unshare_hek
unsharepvn
utilize
wait4pid
+#!/bin/sh
+
+# Written: Nov 1994 Wayne Scott (wscott@ichips.intel.com)
+
+# Create the export list for perl based on 'old_global.sym'.
+# Needed by AIX to do dynamic linking.
+
+# This simple program relys on 'old_global.sym' being up to date
+# with all of the global symbols that a dynamicly link library
+# might want to access.
+
+# All symbols have a Perl_ prefix because that's what embed.h
+# sticks in front of them.
+
+echo "Extracting perl.exp"
+
+rm -f perl.exp
+echo "#!" > perl.exp
+
+sed -n '/^[A-Za-z]/ s/^/Perl_/p' old_global.sym >> perl.exp
+
+#
+# also add symbols from interp.sym
+# They are only needed if -DMULTIPLICITY is not set but it
+# doesn't hurt to include them anyway.
+sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp
+
+# extra globals not included above.
+cat <<END >> perl.exp
+perl_init_i18nl10n
+perl_init_i18nl14n
+perl_new_collate
+perl_new_ctype
+perl_new_numeric
+perl_numeric_local
+perl_numeric_standard
+perl_alloc
+perl_construct
+perl_destruct
+perl_free
+perl_parse
+perl_run
+perl_get_sv
+perl_get_av
+perl_get_hv
+perl_get_cv
+perl_call_argv
+perl_call_pv
+perl_call_method
+perl_call_sv
+perl_requirepv
+END
# grep -v '"\(malloc\|realloc\|free\)"' perl.linkexp >>$@
-# We assume here that perl is available somewhere ...
-
perl.exports: perl.exp EXTERN.h perl.h
- (echo '#include "EXTERN.h"'; echo '#include "perl.h"' ; \
- echo '#include "perl.exp"') | \
+ (echo "#include \"EXTERN.h\" \n#include \"perl.h\" \n#include \"perl.exp\""; \
+ echo "malloc\nrealloc\ncalloc\nfree") | \
$(CC) -DEMBED -E - | \
awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
-# perl -ne 'print if (/^#!/ .. /^#\s/) && s/^(\w+) *$$/$$1/' > $@
-
perl.linkexp: perl.exports perl.map
cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp
WriteMakefile(
'NAME' => 'OS2::ExtAttr',
'VERSION_FROM' => 'ExtAttr.pm', # finds $VERSION
+ MAN3PODS => ' ', # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
'NAME' => 'OS2::PrfDB',
'VERSION_FROM' => 'PrfDB.pm', # finds $VERSION
+ MAN3PODS => ' ', # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
'NAME' => 'OS2::Process',
'VERSION' => '0.1',
+ MAN3PODS => ' ', # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
WriteMakefile(
NAME => 'OS2::REXX',
VERSION => '0.2',
+ MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
);
if (flag == P_WAIT)
flag = P_NOWAIT;
- if (strEQ(Argv[0],"/bin/sh")) Argv[0] = SH_PATH;
+ if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path;
if (Argv[0][0] != '/' && Argv[0][0] != '\\'
&& !(Argv[0][0] && Argv[0][1] == ':'
have a shell which will not change between computers with the
same architecture, to avoid "action on a distance".
And to have simple build, this shell should be sh. */
- shell = SH_PATH;
+ shell = sh_path;
copt = "-c";
#endif
cmd++;
if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
- STRLEN l = strlen(SH_PATH);
+ STRLEN l = strlen(sh_path);
New(4545, news, strlen(cmd) - 7 + l, char);
- strcpy(news, SH_PATH);
+ strcpy(news, sh_path);
strcpy(news + l, cmd + 7);
cmd = news;
}
# else
char *shell = getenv("EMXSHELL");
- my_setenv("EMXSHELL", SH_PATH);
+ my_setenv("EMXSHELL", sh_path);
res = popen(cmd, mode);
my_setenv("EMXSHELL", shell);
# endif
return buf;
}
-char sh_path[STATIC_FILE_LENGTH+1] = SH_PATH_INI;
-
char *
perllib_mangle(char *s, unsigned int l)
{
if (!newp && !notfound) {
newp = getenv("PERLLIB_PREFIX");
if (newp) {
+ char *s;
+
oldp = newp;
while (*newp && !isSPACE(*newp) && *newp != ';') {
newp++; oldl++; /* Skip digits. */
if (newl == 0 || oldl == 0) {
die("Malformed PERLLIB_PREFIX");
}
+ strcpy(ret, newp);
+ s = ret;
+ while (*s) {
+ if (*s == '\\') *s = '/';
+ s++;
+ }
} else {
notfound = 1;
}
if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) {
die("Malformed PERLLIB_PREFIX");
}
- strncpy(ret, newp, newl);
strcpy(ret + newl, s + oldl);
return ret;
}
settmppath();
OS2_Perl_data.xs_init = &Xs_OS2_init;
if ( (shell = getenv("PERL_SH_DRIVE")) ) {
+ New(404, sh_path, strlen(SH_PATH) + 1, char);
+ strcpy(sh_path, SH_PATH);
sh_path[0] = shell[0];
} else if ( (shell = getenv("PERL_SH_DIR")) ) {
- int l = strlen(shell);
+ int l = strlen(shell), i;
if (shell[l-1] == '/' || shell[l-1] == '\\') {
l--;
}
- if (l > STATIC_FILE_LENGTH - 7) {
- die("PERL_SH_DIR too long");
- }
+ New(404, sh_path, l + 8, char);
strncpy(sh_path, shell, l);
strcpy(sh_path + l, "/sh.exe");
+ for (i = 0; i < l; i++) {
+ if (sh_path[i] == '\\') sh_path[i] = '/';
+ }
}
}
#define BIT_BUCKET "/dev/nul" /* Will this work? */
-/* SH_PATH_INI:
- * Duplicate for SH_PATH. This symbol allows redefinition of SH_PATH,
- * which may be needed to make a binary distribution.
- */
-#define SH_PATH_INI SH_PATH /**/
-
#if defined(I_SYS_UN) && !defined(TCPIPV4)
/* It is not working without TCPIPV4 defined. */
# undef I_SYS_UN
}
#define STATIC_FILE_LENGTH 127
-extern char sh_path[STATIC_FILE_LENGTH+1];
-#undef SH_PATH
-#define SH_PATH sh_path
+
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);
#define PATCHLEVEL 3
-#define SUBVERSION 9
+#define SUBVERSION 10
/*
local_patches -- list of locally applied less-than-subversion patches.
/* Use all the "standard" definitions? */
#if defined(STANDARD_C) && defined(I_STDLIB)
# include <stdlib.h>
-#endif /* STANDARD_C */
+#endif
/* This comes after <stdlib.h> so we don't try to change the standard
* library prototypes; we'll use our own in proto.h instead. */
#define MEM_SIZE Size_t
+#if defined(STANDARD_C) && defined(I_STDDEF)
+# include <stddef.h>
+# define OFFSETOF(s,m) offsetof(s,m)
+#else
+# define OFFSETOF(s,m) (Size_t)(&(((s *)0)->m))
+#endif
+
#if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
#else
typedef struct xrv XRV;
typedef struct xpv XPV;
typedef struct xpviv XPVIV;
+typedef struct xpvuv XPVUV;
typedef struct xpvnv XPVNV;
typedef struct xpvmg XPVMG;
typedef struct xpvlv XPVLV;
# endif
#endif
+typedef Signal_t (*Sighandler_t) _((int));
+
+#ifdef HAS_SIGACTION
+typedef struct sigaction Sigsave_t;
+#else
+typedef Sighandler_t Sigsave_t;
+#endif
+
#define SCAN_DEF 0
#define SCAN_TR 1
#define SCAN_REPL 2
EXT U32 * profiledata;
EXT int maxo INIT(MAXO);/* Number of ops */
EXT char * osname; /* operating system */
+EXT char * sh_path INIT(SH_PATH); /* full path of shell */
EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
EXT I32 lex_fakebrack; /* outer bracket is mere delimiter */
EXT I32 lex_casemods; /* casemod count */
EXT I32 lex_dojoin; /* doing an array interpolation */
-EXT I32 lex_endscope; /* maybe end of scope; defer lexical vars */
EXT I32 lex_starts; /* how many interps done on level */
EXT SV * lex_stuff; /* runtime pattern from m// or s/// */
EXT SV * lex_repl; /* runtime replacement from s/// */
# Create the export list for perl.
# Needed by AIX to do dynamic linking.
+# NOTE: If you're using 'old_embed.pl', don't use this script!
+# Use 'old_perl_exp.SH' instead.
+
# This simple program relys on 'global.sym' being up to date
# with all of the global symbols that a dynamicly link library
# might want to access.
sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym >> perl.exp
+#
# also add symbols from interp.sym
# They are only needed if -DMULTIPLICITY is not set but it
# doesn't hurt to include them anyway.
-sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp
+sed -n '/^[A-Za-z]/ s/^/Perl_/p' interp.sym >> perl.exp
# extra globals not included above.
cat <<END >> perl.exp
perl_init_i18nl14n
perl_new_collate
perl_new_ctype
+perl_new_numeric
+perl_numeric_local
+perl_numeric_standard
perl_alloc
perl_construct
perl_destruct
or else see L</select()> below. It is not advised to intermix alarm()
and sleep() calls.
+If you want to use alarm() to time out a system call you need to use an
+eval/die pair. You can't rely on the alarm causing the system call to
+fail with $! set to EINTR because Perl sets up signal handlers to
+restart system calls on some systems. Using eval/die always works.
+
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # NB \n required
+ $nread = sysread SOCKET, $buffer, $size;
+ };
+ die if $@ && $@ ne "alarm\n"; # propagate errors
+ if ($@) {
+ # timed out
+ }
+ else {
+ # didn't
+ }
+
=item atan2 Y,X
Returns the arctangent of Y/X in the range -PI to PI.
capable of returning the $timeleft. If not, they always return
$timeleft equal to the supplied $timeout.
-You can effect a 250-millisecond sleep this way:
+You can effect a sleep of 250 milliseconds this way:
select(undef, undef, undef, 0.25);
specified FILEHANDLE, using the system call read(2). It bypasses
stdio, so mixing this with other kinds of reads may cause confusion.
Returns the number of bytes actually read, or undef if there was an
-error. SCALAR will be grown or shrunk to the length actually read.
-In the case of growing the new data area will be padded with "\0" bytes.
-An OFFSET may be specified to place the read data at some other
-place than the beginning of the string. A negative OFFSET means
-placing the read data at that many bytes counting backwards from the end
-of the string.
+error. SCALAR will be grown or shrunk so that the last byte actually
+read is the last byte of the scalar after the read.
+
+An OFFSET may be specified to place the read data at some place in the
+string other than the beginning. A negative OFFSET specifies
+placement at that many bytes counting backwards from the end of the
+string. A positive OFFSET greater than the length of SCALAR results
+in the string being padded to the required size with "\0" bytes before
+the result of the read is appended.
=item system LIST
stdio, so mixing this with prints may cause confusion. Returns the
number of bytes actually written, or undef if there was an error.
If the length is greater than the available data, only as much data as
-is available will be written. An OFFSET may be specified to write the
-data from some other place than the beginning of the string.
-A negative OFFSET means starting the writing from that many bytes
-counting backwards from the end of the string.
+is available will be written.
+
+An OFFSET may be specified to write the data from some part of the
+string other than the beginning. A negative OFFSET specifies writing
+from that many bytes counting backwards from the end of the string.
=item tell FILEHANDLE
{
dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
- dPOPTOPiirl;
- if (op->op_private & HINT_INTEGER)
- SETi( left << right );
- else
- SETu( (UV)left << right );
+ IV shift = POPi;
+ if (op->op_private & HINT_INTEGER) {
+ IV i = TOPi;
+ SETi( i << shift );
+ }
+ else {
+ UV u = TOPu;
+ SETu( u << shift );
+ }
RETURN;
}
}
{
dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
- dPOPTOPiirl;
- if (op->op_private & HINT_INTEGER)
- SETi( left >> right );
- else
- SETu( (UV)left >> right );
+ IV shift = POPi;
+ if (op->op_private & HINT_INTEGER) {
+ IV i = TOPi;
+ SETi( i >> shift );
+ }
+ else {
+ UV u = TOPu;
+ SETu( u >> shift );
+ }
RETURN;
}
}
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- UV value = SvIV(left) & SvIV(right);
+ UV value = SvUV(left) & SvUV(right);
if (op->op_private & HINT_INTEGER)
SETi( (IV)value );
else
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- UV value = SvIV(left) ^ SvIV(right);
+ UV value = SvUV(left) ^ SvUV(right);
if (op->op_private & HINT_INTEGER)
SETi( (IV)value );
else
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
- UV value = SvIV(left) | SvIV(right);
+ UV value = SvUV(left) | SvUV(right);
if (op->op_private & HINT_INTEGER)
SETi( (IV)value );
else
{
dTOPss;
if (SvNIOKp(sv)) {
- UV value = ~(UV)SvIV(sv);
+ UV value = ~SvUV(sv);
if (op->op_private & HINT_INTEGER)
SETi( (IV)value );
else
#define POPp (SvPVx(POPs, na))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
-#define POPu ((UV)SvIVx(POPs))
+#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define TOPs (*sp)
#define TOPp (SvPV(TOPs, na))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
-#define TOPu ((UV)SvIV(TOPs))
+#define TOPu ((UV)SvUV(TOPs))
#define TOPl ((long)SvIV(TOPs))
/* Go to some pains in the rare event that we must extend the stack. */
#define dPOPPOPssrl SV *right = POPs; SV *left = POPs
#define dPOPPOPnnrl double right = POPn; double left = POPn
#define dPOPPOPiirl IV right = POPi; IV left = POPi
-#define dPOPPOPuurl UV right = POPu; UV left = POPu
#define dPOPTOPssrl SV *right = POPs; SV *left = TOPs
#define dPOPTOPnnrl double right = POPn; double left = TOPn
#define dPOPTOPiirl IV right = POPi; IV left = TOPi
-#define dPOPTOPuurl UV right = POPu; UV left = TOPu
#define RETPUSHYES RETURNX(PUSHs(&sv_yes))
#define RETPUSHNO RETURNX(PUSHs(&sv_no))
# define my_chsize chsize
#endif
-#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
- static int lockf_emulate_flock _((int fd, int operation));
-# define flock lockf_emulate_flock
-#endif
+#ifdef HAS_FLOCK
+# define FLOCK flock
+#else /* no flock() */
+
+# if defined(HAS_FCNTL) && defined(F_SETLK) && defined (F_SETLKW)
+# define FLOCK fcntl_emulate_flock
+# define FCNTL_EMULATE_FLOCK
+# else /* no flock() or fcntl(F_SETLK,...) */
+# ifdef HAS_LOCKF
+# define FLOCK lockf_emulate_flock
+# define LOCKF_EMULATE_FLOCK
+# endif /* lockf */
+# endif /* no flock() or fcntl(F_SETLK,...) */
+
+# ifdef FLOCK
+ static int FLOCK(int, int);
+
+ /*
+ * These are the flock() constants. Since this sytems doesn't have
+ * flock(), the values of the constants are probably not available.
+ */
+# ifndef LOCK_SH
+# define LOCK_SH 1
+# endif
+# ifndef LOCK_EX
+# define LOCK_EX 2
+# endif
+# ifndef LOCK_NB
+# define LOCK_NB 4
+# endif
+# ifndef LOCK_UN
+# define LOCK_UN 8
+# endif
+# endif /* emulating flock() */
+
+#endif /* no flock() */
/* Pushy I/O. */
if (!gv)
goto say_undef;
bufsv = *++MARK;
+ if (! SvOK(bufsv))
+ sv_setpvn(bufsv, "", 0);
buffer = SvPV_force(bufsv, blen);
length = SvIVx(*++MARK);
if (length < 0)
GV *gv;
PerlIO *fp;
-#if defined(HAS_FLOCK) || defined(flock)
+#ifdef FLOCK
argtype = POPi;
if (MAXARG <= 0)
gv = last_in_gv;
else
fp = Nullfp;
if (fp) {
- value = (I32)(flock(PerlIO_fileno(fp), argtype) >= 0);
+ value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0);
}
else
value = 0;
int childpid;
int result;
int status;
- Signal_t (*ihand)(); /* place to save signal during system() */
- Signal_t (*qhand)(); /* place to save signal during system() */
+ Sigsave_t ihand,qhand; /* place to save signals during system() */
#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
if (SP - MARK == 1) {
sleep(5);
}
if (childpid > 0) {
- ihand = signal(SIGINT, SIG_IGN);
- qhand = signal(SIGQUIT, SIG_IGN);
+ rsignal_save(SIGINT, SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, SIG_IGN, &qhand);
do {
result = wait4pid(childpid, &status, 0);
} while (result == -1 && errno == EINTR);
- (void)signal(SIGINT, ihand);
- (void)signal(SIGQUIT, qhand);
+ (void)rsignal_restore(SIGINT, &ihand);
+ (void)rsignal_restore(SIGQUIT, &qhand);
statusvalue = FIXSTATUS(status);
if (result < 0)
value = -1;
#endif
}
-#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+#ifdef FCNTL_EMULATE_FLOCK
+
+/* XXX Emulate flock() with fcntl().
+ What's really needed is a good file locking module.
+*/
+
+static int
+fcntl_emulate_flock(fd, operation)
+int fd;
+int operation;
+{
+ struct flock flock;
+
+ switch (operation & ~LOCK_NB) {
+ case LOCK_SH:
+ flock.l_type = F_RDLCK;
+ break;
+ case LOCK_EX:
+ flock.l_type = F_WRLCK;
+ break;
+ case LOCK_UN:
+ flock.l_type = F_UNLCK;
+ break;
+ default:
+ errno = EINVAL;
+ return -1;
+ }
+ flock.l_whence = SEEK_SET;
+ flock.l_start = flock.l_len = 0L;
+
+ return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+}
+
+#endif /* FCNTL_EMULATE_FLOCK */
+
+#ifdef LOCKF_EMULATE_FLOCK
/* XXX Emulate flock() with lockf(). This is just to increase
portability of scripts. The calls are not completely
# define F_TEST 3 /* Test a region for other processes locks */
# endif
-/* These are the flock() constants. Since this sytems doesn't have
- flock(), the values of the constants are probably not available.
-*/
-# ifndef LOCK_SH
-# define LOCK_SH 1
-# endif
-# ifndef LOCK_EX
-# define LOCK_EX 2
-# endif
-# ifndef LOCK_NB
-# define LOCK_NB 4
-# endif
-# ifndef LOCK_UN
-# define LOCK_UN 8
-# endif
-
static int
lockf_emulate_flock (fd, operation)
int fd;
errno = EWOULDBLOCK;
break;
- /* LOCK_UN - unlock */
+ /* LOCK_UN - unlock (non-blocking is a no-op) */
case LOCK_UN:
+ case LOCK_UN|LOCK_NB:
i = lockf (fd, F_ULOCK, 0);
break;
}
return (i);
}
-#endif
+
+#endif /* LOCKF_EMULATE_FLOCK */
char* regprop _((char* op));
void repeatcpy _((char* to, char* from, I32 len, I32 count));
char* rninstr _((char* big, char* bigend, char* little, char* lend));
+Sighandler_t rsignal _((int, Sighandler_t));
+int rsignal_restore _((int, Sigsave_t*));
+int rsignal_save _((int, Sighandler_t, Sigsave_t*));
+Sighandler_t rsignal_state _((int));
int runops _((void));
#ifndef HAS_RENAME
I32 same_dirent _((char* a, char* b));
SV* sv_2mortal _((SV* sv));
double sv_2nv _((SV* sv));
char* sv_2pv _((SV* sv, STRLEN* lp));
+UV sv_2uv _((SV* sv));
void sv_add_arena _((char* ptr, U32 size, U32 flags));
int sv_backoff _((SV* sv));
SV* sv_bless _((SV* sv, HV* stash));
+#! /bin/sh
+#__USAGE
+#%C key library name ...
+# Crude cover for wlib to be compatible with ar
+# Supports the following key letters:
+# qcru
+# ru replace existing modules. u indicates only replace
+# those which are newer
+# c create the library (kinda moot)
+# q quickly append to the end.
+#
+#This is a crude cover, but it has proved sufficient for many
+#ports. Rather than attempt to implement subtleties of the
+#ar syntax, I simply create a new library under all
+#circumstances. A much more thorough cover is available from
+#http://www.fdma.com/pub/qnx/porting/ar
+#
+#Note that Watcom 10.6 supports ar directly, so this
+#cover is not necessary.
+#
+#Increased the record size to 32 to accomodate a large library
+#in the perl 5.003 distribution
+#
+#Submitted by Norton T. Allen (allen@huarp.harvard.edu)
+
+if [ $# -lt 3 ]; then
+ use $0
+ exit 1
+fi
+shift
+library=$1
+shift
+wlib -p=32 -n $library `for i in $*; do echo "+$i \\c"; done`
+#! /bin/sh
+#__USAGE
+#%C [-P] [-C] other options
+# cpp is a wrapper for wcc to make it work like other cpp's
+# -P omit #line directives from the output
+# -C pass comments through to the output
+#
+#Submitted by Norton T. Allen (allen@huarp.harvard.edu)
+
+typeset lines=l comments="" redir=""
+while :; do
+ case $1 in
+ -P) lines=""; shift; continue;;
+ -C) comments=c; shift; continue;;
+ esac
+ break
+done
+if [ ! -t 0 ]; then
+ cat >.$$.c
+ redir=.$$.c
+fi
+cc -c -Wc,-p$lines$comments -Wc,-pw=0 $* $redir |
+ awk 'NR>1||NF>0 {sub("^ ","");print}'
+[ -n "$redir" ] && rm -f $redir
if (SvNVX(sv) < 0.0)
SvIVX(sv) = I_V(SvNVX(sv));
else
- SvIVX(sv) = (IV) U_V(SvNVX(sv));
+ SvUVX(sv) = U_V(SvNVX(sv));
}
else if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !looks_like_number(sv))
return SvIVX(sv);
}
+UV
+sv_2uv(sv)
+register SV *sv;
+{
+ if (!sv)
+ return 0;
+ if (SvGMAGICAL(sv)) {
+ mg_get(sv);
+ if (SvIOKp(sv))
+ return SvUVX(sv);
+ if (SvNOKp(sv))
+ return U_V(SvNVX(sv));
+ if (SvPOKp(sv) && SvLEN(sv)) {
+ if (dowarn && !looks_like_number(sv))
+ not_a_number(sv);
+ return (UV)atol(SvPVX(sv));
+ }
+ if (!SvROK(sv)) {
+ return 0;
+ }
+ }
+ if (SvTHINKFIRST(sv)) {
+ if (SvROK(sv)) {
+#ifdef OVERLOAD
+ SV* tmpstr;
+ if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+ return SvUV(tmpstr);
+#endif /* OVERLOAD */
+ return (UV)SvRV(sv);
+ }
+ if (SvREADONLY(sv)) {
+ if (SvNOKp(sv)) {
+ return U_V(SvNVX(sv));
+ }
+ if (SvPOKp(sv) && SvLEN(sv)) {
+ if (dowarn && !looks_like_number(sv))
+ not_a_number(sv);
+ return (UV)atol(SvPVX(sv));
+ }
+ if (dowarn)
+ warn(warn_uninit);
+ return 0;
+ }
+ }
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ sv_upgrade(sv, SVt_IV);
+ return SvUVX(sv);
+ case SVt_PV:
+ sv_upgrade(sv, SVt_PVIV);
+ break;
+ case SVt_NV:
+ sv_upgrade(sv, SVt_PVNV);
+ break;
+ }
+ if (SvNOKp(sv)) {
+ (void)SvIOK_on(sv);
+ SvUVX(sv) = U_V(SvNVX(sv));
+ }
+ else if (SvPOKp(sv) && SvLEN(sv)) {
+ if (dowarn && !looks_like_number(sv))
+ not_a_number(sv);
+ (void)SvIOK_on(sv);
+ SvUVX(sv) = (UV)atol(SvPVX(sv));
+ }
+ else {
+ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ warn(warn_uninit);
+ return 0;
+ }
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
+ (unsigned long)sv,SvUVX(sv)));
+ return SvUVX(sv);
+}
+
double
sv_2nv(sv)
register SV *sv;
(void)SvOK_off(dstr);
return;
case SVt_IV:
- if (dtype <= SVt_PV) {
+ if (dtype != SVt_IV && dtype < SVt_PVIV) {
if (dtype < SVt_IV)
sv_upgrade(dstr, SVt_IV);
else if (dtype == SVt_NV)
sv_upgrade(dstr, SVt_PVNV);
- else if (dtype <= SVt_PV)
+ else
sv_upgrade(dstr, SVt_PVIV);
}
break;
case SVt_NV:
- if (dtype <= SVt_PVIV) {
+ if (dtype != SVt_NV && dtype < SVt_PVNV) {
if (dtype < SVt_NV)
sv_upgrade(dstr, SVt_NV);
- else if (dtype == SVt_PVIV)
- sv_upgrade(dstr, SVt_PVNV);
- else if (dtype <= SVt_PV)
+ else
sv_upgrade(dstr, SVt_PVNV);
}
break;
* has to be allocated and SvPVX(sstr) has to be freed.
*/
- if ((SvTEMP(sstr) || SvPADTMP(sstr)) && /* slated for free anyway? */
+ if (SvTEMP(sstr) && /* slated for free anyway? */
!(sflags & SVf_OOK)) /* and not involved in OOK hack? */
{
if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */
}
if (!SvUPGRADE(sv, SVt_PV))
return 0;
+ SvSCREAM_off(sv);
if (RsSNARF(rs)) {
rsptr = NULL;
register SV *old;
{
register SV *sv;
- U32 oflags;
if (!old)
return Nullsv;
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
- oflags = SvFLAGS(old) & (SVs_TEMP|SVs_PADTMP);
- if (oflags) {
- SvFLAGS(old) &= ~(SVs_TEMP|SVs_PADTMP);
+ if (SvTEMP(old)) {
+ SvTEMP_off(old);
sv_setsv(sv,old);
- SvFLAGS(old) |= oflags;
+ SvTEMP_on(old);
}
else
sv_setsv(sv,old);
}
}
}
-#endif /* SvTRUE */
+#endif /* !SvTRUE */
#ifndef SvIV
-IV SvIV(Sv)
-register SV *Sv;
+IV
+SvIV(sv)
+register SV *sv;
{
- if (SvIOK(Sv))
- return SvIVX(Sv);
- return sv_2iv(Sv);
+ if (SvIOK(sv))
+ return SvIVX(sv);
+ return sv_2iv(sv);
}
-#endif /* SvIV */
+#endif /* !SvIV */
+#ifndef SvUV
+UV
+SvUV(sv)
+register SV *sv;
+{
+ if (SvIOK(sv))
+ return SvUVX(sv);
+ return sv_2uv(sv);
+}
+#endif /* !SvUV */
#ifndef SvNV
-double SvNV(Sv)
-register SV *Sv;
+double
+SvNV(sv)
+register SV *sv;
{
- if (SvNOK(Sv))
- return SvNVX(Sv);
- if (SvIOK(Sv))
- return (double)SvIVX(Sv);
- return sv_2nv(Sv);
+ if (SvNOK(sv))
+ return SvNVX(sv);
+ return sv_2nv(sv);
}
-#endif /* SvNV */
+#endif /* !SvNV */
#ifdef CRIPPLED_CC
char *
IV xiv_iv; /* integer value or pv offset */
};
+struct xpvuv {
+ char * xpv_pv; /* pointer to malloced string */
+ STRLEN xpv_cur; /* length of xpv_pv as a C string */
+ STRLEN xpv_len; /* allocated size */
+ UV xuv_uv; /* unsigned value or pv offset */
+};
+
struct xpvnv {
char * xpv_pv; /* pointer to malloced string */
STRLEN xpv_cur; /* length of xpv_pv as a C string */
#define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv
#define SvIVXx(sv) SvIVX(sv)
+#define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv
+#define SvUVXx(sv) SvUVX(sv)
#define SvNVX(sv) ((XPVNV*)SvANY(sv))->xnv_nv
#define SvNVXx(sv) SvNVX(sv)
#define SvPVX(sv) ((XPV*) SvANY(sv))->xpv_pv
#ifdef CRIPPLED_CC
IV SvIV _((SV* sv));
+UV SvUV _((SV* sv));
double SvNV _((SV* sv));
#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
#define SvPV(sv, lp) sv_pvn(sv, &lp)
I32 SvTRUE _((SV *));
#define SvIVx(sv) SvIV(sv)
+#define SvUVx(sv) SvUV(sv)
#define SvNVx(sv) SvNV(sv)
#define SvPVx(sv, lp) sv_pvn(sv, &lp)
#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
#else /* !CRIPPLED_CC */
+#undef SvIV
#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv))
+#undef SvUV
+#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+
+#undef SvNV
#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
-#define SvPV(sv, lp) (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp))
+#undef SvPV
+#define SvPV(sv, lp) \
+ (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp))
-#define SvPV_force(sv, lp) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force(sv, &lp))
+#undef SvPV_force
+#define SvPV_force(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force(sv, &lp))
+#undef SvTRUE
#define SvTRUE(sv) ( \
!sv \
? 0 \
: sv_2bool(sv) )
#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
+#define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
#define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
`echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
}
-open(CONFIG,"../config.sh");
-while (<CONFIG>) {
- if (/sharpbang='(.*)'/) {
- $sharpbang = ($1 eq '#!');
- last;
+if ($^O eq 'os2' || $^O eq 'qnx') {
+ $sharpbang = 0;
+}
+else {
+ open(CONFIG, "../config.sh");
+ while (<CONFIG>) {
+ if (/sharpbang='(.*)'/) {
+ $sharpbang = ($1 eq '#!');
+ last;
+ }
}
+ close(CONFIG);
}
-$sharpbang = 0 if $ENV{OS2_SHELL}; # OS/2
+
$bad = 0;
$good = 0;
$total = @ARGV;
# Check string conversion functions.
if ($Config{d_strtod}) {
+ $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
($n, $x) = &POSIX::strtod('3.14159_OR_SO');
print (($n == 3.14159) && ($x == 6) ? "ok 14\n" : "not ok 14\n");
+ &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
} else { print "# strtod not present\n", "ok 14\n"; }
if ($Config{d_strtol}) {
case XOPERATOR:
while (s < bufend && (*s == ' ' || *s == '\t'))
s++;
- if (s < bufend && (isALPHA(*s) || *s == '_')) {
+ if (s < bufend && isIDFIRST(*s)) {
d = scan_word(s, tokenbuf, FALSE, &len);
while (d < bufend && (*d == ' ' || *d == '\t'))
d++;
TERM(THING);
}
+ d = s;
+ if (lex_state == LEX_NORMAL)
+ s = skipspace(s);
+
if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
char *t;
if (*s == '[') {
}
expect = XOPERATOR;
- if (lex_state == LEX_NORMAL && isSPACE(*s)) {
+ if (lex_state == LEX_NORMAL && isSPACE(*d)) {
bool islop = (last_lop == oldoldbufptr);
- s = skipspace(s);
if (!islop || last_lop_op == OP_GREPSTART)
expect = XOPERATOR;
else if (strchr("$@\"'`q", *s))
yyerror("Final @ should be \\@ or @name");
PREREF('@');
}
+ if (lex_state == LEX_NORMAL)
+ s = skipspace(s);
if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
if (*s == '{')
tokenbuf[0] = '%';
FUN0(OP_GPWENT);
case KEY_getpwnam:
- FUN1(OP_GPWNAM);
+ UNI(OP_GPWNAM);
case KEY_getpwuid:
- FUN1(OP_GPWUID);
+ UNI(OP_GPWUID);
case KEY_getpeername:
UNI(OP_GETPEERNAME);
FUN0(OP_GGRENT);
case KEY_getgrnam:
- FUN1(OP_GGRNAM);
+ UNI(OP_GGRNAM);
case KEY_getgrgid:
- FUN1(OP_GGRGID);
+ UNI(OP_GGRGID);
case KEY_getlogin:
FUN0(OP_GETLOGIN);
LOP(OP_SETPRIORITY,XTERM);
case KEY_sethostent:
- FUN1(OP_SHOSTENT);
+ UNI(OP_SHOSTENT);
case KEY_setnetent:
- FUN1(OP_SNETENT);
+ UNI(OP_SNETENT);
case KEY_setservent:
- FUN1(OP_SSERVENT);
+ UNI(OP_SSERVENT);
case KEY_setprotoent:
- FUN1(OP_SPROTOENT);
+ UNI(OP_SPROTOENT);
case KEY_setpwent:
FUN0(OP_SPWENT);
while (s < send && (*s == ' ' || *s == '\t')) s++;
*d = *s;
}
- if (isALPHA(*d) || *d == '_') {
+ if (isIDFIRST(*d)) {
d++;
while (isALNUM(*s) || *s == ':')
*d++ = *s++;
*d = '\0';
while (s < send && (*s == ' ' || *s == '\t')) s++;
- if ((*s == '[' || *s == '{')) {
+ if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
if (dowarn && keyword(dest, d - dest)) {
char *brack = *s == '[' ? "[...]" : "{...}";
warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
CV* outsidecv = compcv;
AV* comppadlist;
-#ifndef __QNX__
if (compcv) {
assert(SvTYPE(compcv) == SVt_PVCV);
}
-#endif
save_I32(&subline);
save_item(subname);
SAVEI32(padix);
# include <sys/file.h>
#endif
+#ifdef I_SYS_WAIT
+# include <sys/wait.h>
+#endif
+
#define FLUSH
#ifdef LEAKTEST
++collation_ix;
Safefree(collation_name);
collation_name = savepv(newcoll);
- collation_standard = strEQ(newcoll, "C");
+ collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX"));
#ifdef HAS_STRXFRM
{
if (! numeric_name || strNE(numeric_name, newnum)) {
Safefree(numeric_name);
numeric_name = savepv(newnum);
- numeric_standard = strEQ(newnum, "C");
+ numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
numeric_local = TRUE;
}
}
}
#endif
+
+#ifdef HAS_SIGACTION
+
+Sighandler_t
+rsignal(signo, handler)
+int signo;
+Sighandler_t handler;
+{
+ struct sigaction act, oact;
+
+ act.sa_handler = handler;
+ sigemptyset(&act.sa_mask);
+ act.sa_flags = 0;
+#ifdef SA_RESTART
+ act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
+#endif
+ if (sigaction(signo, &act, &oact) == -1)
+ return(SIG_ERR);
+ else
+ return(oact.sa_handler);
+}
+
+Sighandler_t
+rsignal_state(signo)
+int signo;
+{
+ struct sigaction oact;
+
+ if (sigaction(signo, (struct sigaction *)NULL, &oact) == -1)
+ return SIG_ERR;
+ else
+ return oact.sa_handler;
+}
+
+int
+rsignal_save(signo, handler, save)
+int signo;
+Sighandler_t handler;
+Sigsave_t *save;
+{
+ struct sigaction act;
+
+ act.sa_handler = handler;
+ sigemptyset(&act.sa_mask);
+ act.sa_flags = 0;
+#ifdef SA_RESTART
+ act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
+#endif
+ return sigaction(signo, &act, save);
+}
+
+int
+rsignal_restore(signo, save)
+int signo;
+Sigsave_t *save;
+{
+ return sigaction(signo, save, (struct sigaction *)NULL);
+}
+
+#else /* !HAS_SIGACTION */
+
+Sighandler_t
+rsignal(signo, handler)
+int signo;
+Sighandler_t handler;
+{
+ return signal(signo, handler);
+}
+
+static int sig_trapped;
+
+static
+Signal_t
+sig_trap(signo)
+int signo;
+{
+ sig_trapped++;
+}
+
+Sighandler_t
+rsignal_state(signo)
+int signo;
+{
+ Sighandler_t oldsig;
+
+ sig_trapped = 0;
+ oldsig = signal(signo, sig_trap);
+ signal(signo, oldsig);
+ if (sig_trapped)
+ kill(getpid(), signo);
+ return oldsig;
+}
+
+int
+rsignal_save(signo, handler, save)
+int signo;
+Sighandler_t handler;
+Sigsave_t *save;
+{
+ *save = signal(signo, handler);
+ return (*save == SIG_ERR) ? -1 : 0;
+}
+
+int
+rsignalrestore(signo, save)
+int signo;
+Sigsave_t *save;
+{
+ return (signal(signo, *save) == SIG_ERR) ? -1 : 0;
+}
+
+#endif /* !HAS_SIGACTION */
+
+
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \
&& !defined(VMS) /* VMS' my_popen() is in VMS.c */
I32
my_pclose(ptr)
PerlIO *ptr;
{
- Signal_t (*hstat)(), (*istat)(), (*qstat)();
+ Sigsave_t hstat, istat, qstat;
int status;
SV **svp;
int pid;
#ifdef UTS
if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
- hstat = signal(SIGHUP, SIG_IGN);
- istat = signal(SIGINT, SIG_IGN);
- qstat = signal(SIGQUIT, SIG_IGN);
+ rsignal_save(SIGHUP, SIG_IGN, &hstat);
+ rsignal_save(SIGINT, SIG_IGN, &istat);
+ rsignal_save(SIGQUIT, SIG_IGN, &qstat);
do {
pid = wait4pid(pid, &status, 0);
} while (pid == -1 && errno == EINTR);
- signal(SIGHUP, hstat);
- signal(SIGINT, istat);
- signal(SIGQUIT, qstat);
+ rsignal_restore(SIGHUP, &hstat);
+ rsignal_restore(SIGINT, &istat);
+ rsignal_restore(SIGQUIT, &qstat);
return(pid < 0 ? pid : status);
}
#endif /* !DOSISH */
--- /dev/null
+/* proto.h
+ *
+ * Copyright (c) 1991-1996, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
projects / p5sagit/p5-mst-13.2.git / commitdiff