diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-11-30 05:31:00 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1996-11-30 05:31:00 +1200 |
| commit | ff68c7194e176ca1907544a3a65684b76834d0fe (patch) | |
| tree | 4124d603a6b2a937f4ce1d9469426f84421f93e0 | |
| parent | eff9c6e2f5bda63e4dc69fc15e237a9843954369 (diff) | |
| download | perl-ff68c7194e176ca1907544a3a65684b76834d0fe.tar.gz | |
[inseparable changes from patch from perl5.003_09 to perl5.003_10]
CORE LANGUAGE CHANGES
Subject: Allow &{sub {...}} without warning
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c
Subject: Make parens optional on [gs]ethost and [gs]et{pw,gr} function
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c
Subject: Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c
DOCUMENTATION
Subject: Improve documentation for sysread() and syswrite()
From: Chip Salzenberg <chip@atlantic.net>
Files: pod/perlfunc.pod
Subject: Document how to use $SIG{ALRM} and alarm()
Date: Tue, 26 Nov 1996 11:42:49 -0500
From: Roderick Schertler <roderick@ibcinc.com>
Files: pod/perlfunc.pod
Msg-ID: <5898.849026569@eeyore.ibcinc.com>
(applied based on p5p patch as commit 5fa5e7dfc2abaaadd377c97cd1ebe78ea844da88)
OTHER CORE CHANGES
Subject: Hash key memory corruption fix and naming cleanup
From: Chip Salzenberg <chip@atlantic.net>
Files: hv.c hv.h perl.h
Subject: Undo broken perf. patch (PADTMP stealing)
From: Chip Salzenberg <chip@atlantic.net>
Files: sv.c
Subject: Make SV unstudied in sv_gets()
From: Chip Salzenberg <chip@atlantic.net>
Files: sv.c
Subject: Better support for UVs
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: global.sym old_global.sym perl.h pp.c pp.h proto.h sv.c sv.h
Subject: Minor locale cleanups
From: Chip Salzenberg <chip@atlantic.net>
Files: t/lib/posix.t util.c
Accept "POSIX" locale as standard like "C". Reset locale to
'C' when testing strtod() in t/lib/posix.t.
Subject: Always taint result of sprintf() on float
From: Chip Salzenberg <chip@atlantic.net>
Files: doop.c
Subject: Fix spurious warning from bitwise string ops
From: Chip Salzenberg <chip@atlantic.net>
Files: doop.c
Subject: Eliminate warning on {,sys}read(,$newvar,)
From: Chip Salzenberg <chip@atlantic.net>
Files: doop.c pp_sys.c
Subject: Namespace cleanup
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym old_global.sym perl.h
Subject: 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
Subject: Reliable signal patch
Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST)
From: Kenneth Albanowski <kjahds@kjahds.com>
Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c
Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com>
(applied based on p5p patch as commit 679728958e74b0ccd6d61567d84851f1ef994e1f)
Subject: Emulate missing flock() with either fcntl() or lockf()
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c
Subject: 3_09: minor patches for OS/2
Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
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
Subject: 3_09: minor patches
This patches mostly enable commpilation under OS/2, and fix malloc.c.
Enjoy,
p5p-msgid: <199611270830.DAA04985@monk.mps.ohio-state.edu>
Subject: Re: 5.003_09 and QNX
Date: Wed, 27 Nov 96 13:36:06 est
From: Norton Allen <nort@bottesini.harvard.edu>
Files: Configure MANIFEST README.qnx hints/qnx.sh qnx/ar qnx/cpp t/TEST toke.c util.c x2p/proto.h
Msg-ID: <9611271836.AA14460@bottesini.harvard.edu>
(applied based on p5p patch as commit c5117498be098729dc2af28089bd130c88c8d42b)
| -rw-r--r-- | Changes | 330 | ||||
| -rwxr-xr-x | Configure | 77 | ||||
| -rw-r--r-- | INSTALL | 17 | ||||
| -rw-r--r-- | MANIFEST | 8 | ||||
| -rwxr-xr-x | Makefile.SH | 17 | ||||
| -rw-r--r-- | README.qnx | 22 | ||||
| -rw-r--r-- | doio.c | 2 | ||||
| -rw-r--r-- | doop.c | 27 | ||||
| -rw-r--r-- | embed.h | 13 | ||||
| -rw-r--r-- | ext/DB_File/DB_File.pm | 10 | ||||
| -rw-r--r-- | ext/DB_File/DB_File.xs | 6 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 1 | ||||
| -rw-r--r-- | ext/SDBM_File/sdbm/sdbm.h | 18 | ||||
| -rw-r--r-- | global.sym | 13 | ||||
| -rw-r--r-- | handy.h | 85 | ||||
| -rw-r--r-- | hints/qnx.sh | 176 | ||||
| -rw-r--r-- | hv.c | 58 | ||||
| -rw-r--r-- | hv.h | 28 | ||||
| -rw-r--r-- | lib/ExtUtils/Embed.pm | 2 | ||||
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 12 | ||||
| -rw-r--r-- | malloc.c | 27 | ||||
| -rw-r--r-- | mg.c | 59 | ||||
| -rw-r--r-- | old_global.sym | 23 | ||||
| -rwxr-xr-x | old_perl_exp.SH | 52 | ||||
| -rw-r--r-- | os2/Makefile.SHs | 8 | ||||
| -rw-r--r-- | os2/OS2/ExtAttr/Makefile.PL | 1 | ||||
| -rw-r--r-- | os2/OS2/PrfDB/Makefile.PL | 1 | ||||
| -rw-r--r-- | os2/OS2/Process/Makefile.PL | 1 | ||||
| -rw-r--r-- | os2/OS2/REXX/Makefile.PL | 1 | ||||
| -rw-r--r-- | os2/os2.c | 32 | ||||
| -rw-r--r-- | os2/os2ish.h | 10 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | perl.h | 20 | ||||
| -rwxr-xr-x | perl_exp.SH | 9 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 43 | ||||
| -rw-r--r-- | pp.c | 36 | ||||
| -rw-r--r-- | pp.h | 6 | ||||
| -rw-r--r-- | pp_sys.c | 116 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rwxr-xr-x | qnx/ar | 33 | ||||
| -rwxr-xr-x | qnx/cpp | 24 | ||||
| -rw-r--r-- | sv.c | 138 | ||||
| -rw-r--r-- | sv.h | 27 | ||||
| -rwxr-xr-x | t/TEST | 18 | ||||
| -rwxr-xr-x | t/lib/posix.t | 2 | ||||
| -rw-r--r-- | toke.c | 33 | ||||
| -rw-r--r-- | util.c | 136 | ||||
| -rw-r--r-- | x2p/proto.h | 8 |
48 files changed, 1425 insertions, 368 deletions
@@ -8,6 +8,336 @@ or in the .../src/5/0/unsupported directory for sub-version 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 ---------------- @@ -848,11 +848,11 @@ cat >>extract <<'EOS' 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 @@ -860,7 +860,7 @@ if test -f MANIFEST; then 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 @@ -1774,6 +1774,9 @@ EOM uts) osname=uts osvers="$3" ;; + qnx) osname=qnx + osvers="$4" + ;; $2) case "$osname" in *isc*) ;; *freebsd*) ;; @@ -2016,7 +2019,7 @@ if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then tarch=`arch`"-$osname" elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then if uname -m > tmparch 2>&1 ; then - tarch=`$sed -e 's/ /_/g' -e 's/$/'"-$osname/" tmparch` + tarch=`$sed -e 's/ /_/g' -e 's/_*$//' -e 's/$/'"-$osname/" tmparch` else tarch="$osname" fi @@ -3231,6 +3234,11 @@ rp='What is the file extension used for shared libraries?' . ./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 @@ -3255,25 +3263,25 @@ for thislib in $libswanted; do *"-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 "*);; @@ -3824,7 +3832,7 @@ echo " " 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 @@ -3842,13 +3850,15 @@ case "$libs" in : 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='' @@ -3898,25 +3908,25 @@ elif $test -r /lib/libc && $test -r /lib/clib; then 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." @@ -4075,9 +4085,6 @@ $rm -f libnames libpath case "$ar" in '') ar='ar';; esac -case "$lib_ext" in -'') lib_ext='.a';; -esac case "$obj_ext" in '') obj_ext='.o';; esac @@ -5897,19 +5904,19 @@ if set crypt val -f d_crypt; eval $csym; $val; then 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 @@ -7319,10 +7326,10 @@ else : 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" @@ -7335,7 +7342,7 @@ else 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 @@ -8409,14 +8416,14 @@ EOP $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 @@ -641,6 +641,23 @@ various other operating systems. =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. @@ -16,6 +16,7 @@ Porting/Glossary Glossary of config.sh variables. 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 @@ -239,6 +240,7 @@ hints/next_3_0.sh Hints for named architecture 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 @@ -391,6 +393,7 @@ myconfig Prints summary of the current configuration 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 @@ -516,6 +519,8 @@ pp_ctl.c Push/Pop code for control flow 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 @@ -668,7 +673,7 @@ toke.c The tokener 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 @@ -716,6 +721,7 @@ x2p/cflags.SH A script that emits C compilation flags per file 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 diff --git a/Makefile.SH b/Makefile.SH index 9052a4dfed..1a2d67d64c 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -401,7 +401,16 @@ clean: 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 @@ -417,12 +426,6 @@ realclean: clean 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. diff --git a/README.qnx b/README.qnx new file mode 100644 index 0000000000..0cfe3533ca --- /dev/null +++ b/README.qnx @@ -0,0 +1,22 @@ +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) @@ -1027,7 +1027,7 @@ char *cmd; break; } doshell: - execl(SH_PATH, "sh", "-c", cmd, (char*)0); + execl(sh_path, "sh", "-c", cmd, (char*)0); return FALSE; } } @@ -274,10 +274,14 @@ register SV **sarg; (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); @@ -539,12 +543,21 @@ SV *right; 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); @@ -237,6 +237,7 @@ #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 @@ -312,6 +313,10 @@ #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 @@ -992,6 +997,10 @@ #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 @@ -1049,6 +1058,7 @@ #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 @@ -1063,6 +1073,7 @@ #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 @@ -1094,6 +1105,7 @@ #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 @@ -1123,6 +1135,7 @@ #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 diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index fcc84c3c69..f62de2ebc9 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # 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 ; @@ -149,7 +149,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ; use Carp; -$VERSION = "1.05" ; +$VERSION = "1.06" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -1518,6 +1518,10 @@ Made all scripts in the documentation C<strict> and C<-w> clean. 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 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 3832a26c77..f7dc37824d 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ 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 @@ -27,6 +27,7 @@ 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. */ @@ -273,6 +274,7 @@ RECNOINFO * recno ; printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ; } +static void PrintBtree(btree) BTREEINFO * btree ; { diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index a94c9422aa..e4aa293948 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -33,7 +33,6 @@ #if defined(I_TERMIOS) #include <termios.h> #endif -#include <stdio.h> #ifdef I_STDLIB #include <stdlib.h> #endif diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index c05f0d0fa8..11967ecdc9 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -79,15 +79,15 @@ extern DBM *sdbm_prep proto((char *, char *, int, int)); 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. */ diff --git a/global.sym b/global.sym index ca7240a126..729aa18bc4 100644 --- a/global.sym +++ b/global.sym @@ -221,6 +221,7 @@ scrgv seq_amg sge_amg sgt_amg +sh_path sig_name sig_num sighandler @@ -299,6 +300,10 @@ yyval # Functions Gv_AMupdate +SvTRUE +SvIV +SvUV +SvNV amagic_call append_elem append_list @@ -979,6 +984,10 @@ regnext regprop repeatcpy rninstr +rsignal +rsignal_save +rsignal_state +rsignal_restore runops safecalloc safemalloc @@ -1036,6 +1045,7 @@ scope screaminstr setdefout setenv_getix +share_hek sharepvn sighandler skipspace @@ -1050,6 +1060,7 @@ sv_2iv sv_2mortal sv_2nv sv_2pv +sv_2uv sv_add_arena sv_backoff sv_bless @@ -1081,6 +1092,7 @@ sv_mortalcopy sv_newmortal sv_newref sv_peek +sv_pvn sv_pvn_force sv_ref sv_reftype @@ -1110,6 +1122,7 @@ taint_proper too_few_arguments too_many_arguments unlnk +unshare_hek unsharepvn utilize wait4pid @@ -113,7 +113,7 @@ typedef unsigned short U16; # 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)) @@ -158,24 +158,26 @@ typedef unsigned short U16; #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)) @@ -188,7 +190,7 @@ typedef unsigned short U16; # 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)) @@ -226,50 +228,55 @@ typedef U16 line_t; #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 diff --git a/hints/qnx.sh b/hints/qnx.sh new file mode 100644 index 0000000000..e0ce55c249 --- /dev/null +++ b/hints/qnx.sh @@ -0,0 +1,176 @@ +#---------------------------------------------------------------- +# 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 @@ -64,12 +64,12 @@ U32 hash; 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; } @@ -77,7 +77,7 @@ void 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 @@ -168,14 +168,17 @@ register U32 hash; 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; @@ -277,9 +280,9 @@ register U32 hash; 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; @@ -350,9 +353,9 @@ register U32 hash; 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; @@ -752,11 +755,11 @@ I32 shared; 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); } @@ -770,11 +773,11 @@ I32 shared; 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); } @@ -894,11 +897,14 @@ HV *hv; 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); @@ -909,7 +915,7 @@ HV *hv; } 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*); @@ -1008,7 +1014,7 @@ char* sv; 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 @@ -1046,7 +1052,7 @@ U32 hash; *oentry = HeNEXT(entry); if (i && !*oentry) xhv->xhv_fill--; - Safefree(HeKEY_hk(entry)); + Safefree(HeKEY_hek(entry)); del_he(entry); --xhv->xhv_keys; } @@ -1093,7 +1099,7 @@ register U32 hash; } 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; @@ -1106,7 +1112,7 @@ register U32 hash; } ++HeVAL(entry); /* use value slot as REFCNT */ - return HeKEY_hk(entry); + return HeKEY_hek(entry); } @@ -8,18 +8,18 @@ */ 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 { @@ -89,12 +89,12 @@ 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)) @@ -110,6 +110,8 @@ struct xpvhv { &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 diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index 97832929f1..c4a3c68bb0 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -222,7 +222,7 @@ sub ccdlflags { } sub perl_inc { - print " -I$Config{archlib}/CORE "; + print " -I$Config{archlibexp}/CORE "; } sub ccopts { diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 6823955113..70796bd525 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -76,7 +76,7 @@ perl(1), perlxs(1), perlxstut(1), perlxs(1) =cut # Global Constants -$XSUBPP_version = "1.939"; +$XSUBPP_version = "1.940"; require 5.002; use vars '$cplusplus'; @@ -95,7 +95,7 @@ $ProtoUsed = 0 ; 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'; @@ -661,6 +661,7 @@ sub fetch_para { $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; @@ -791,12 +792,13 @@ while (fetch_para()) { ($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} ++ ; @@ -840,7 +842,7 @@ while (fetch_para()) { # print function header print Q<<"EOF"; -#XS(XS_${Packid}_$func_name) +#XS(XS_${Full_func_name}) #[[ # dXSARGS; EOF @@ -112,8 +112,8 @@ static int findbucket _((union overhead *freep, int srchlen)); # 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) + \ @@ -195,7 +195,7 @@ emergency_sbrk(size) /* 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 */ } @@ -205,7 +205,8 @@ emergency_sbrk(size) 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; } @@ -379,11 +380,11 @@ morecore(bucket) 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; @@ -408,19 +409,21 @@ morecore(bucket) #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--; } @@ -634,46 +634,6 @@ MAGIC* mg; 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; @@ -686,15 +646,10 @@ MAGIC* mg; 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); @@ -768,7 +723,7 @@ MAGIC* mg; } if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) { if (i) - (void)rsignal(i,sighandler); + (void)rsignal(i, sighandler); else *svp = SvREFCNT_inc(sv); return 0; @@ -776,13 +731,13 @@ MAGIC* mg; 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; } @@ -794,7 +749,7 @@ MAGIC* mg; sv_setpv(sv,tokenbuf); } if (i) - (void)rsignal(i,sighandler); + (void)rsignal(i, sighandler); else *svp = SvREFCNT_inc(sv); } diff --git a/old_global.sym b/old_global.sym index b63df1cfd3..5c7409d287 100644 --- a/old_global.sym +++ b/old_global.sym @@ -34,7 +34,6 @@ compcv comppad comppad_name comppad_name_fill -comppad_name_floor concat_amg concat_ass_amg cop_seqmax @@ -48,12 +47,10 @@ curinterp curpad cv_const_sv dc -debug dec_amg di div_amg div_ass_amg -do_undump ds egid envgv @@ -213,6 +210,7 @@ scrgv seq_amg sge_amg sgt_amg +sh_path sig_name sig_num siggv @@ -250,10 +248,12 @@ vtbl_collxfrm vtbl_dbline vtbl_env vtbl_envelem +vtbl_fm vtbl_glob vtbl_isa vtbl_isaelem vtbl_mglob +vtbl_nkeys vtbl_pack vtbl_packelem vtbl_pos @@ -317,6 +317,7 @@ cast_ulong check_uni checkcomma ck_aelem +ck_bitop ck_concat ck_delete ck_eof @@ -425,11 +426,13 @@ gv_HVadd 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 @@ -451,6 +454,7 @@ hv_iterkeysv hv_iternext hv_iternextsv hv_iterval +hv_ksplit hv_magic hv_stashpv hv_store @@ -491,12 +495,14 @@ magic_set 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 @@ -507,6 +513,7 @@ magic_setvec magic_wipepack magicname markstack_grow +mem_collxfrm mess mg_clear mg_copy @@ -962,8 +969,13 @@ regnext regprop repeatcpy rninstr +rsignal +rsignal_save +rsignal_state +rsignal_restore runops same_dirent +save_I16 save_I32 save_aptr save_ary @@ -1010,6 +1022,7 @@ scope screaminstr setdefout setenv_getix +share_hek sharepvn sighandler skipspace @@ -1024,6 +1037,7 @@ sv_2iv sv_2mortal sv_2nv sv_2pv +sv_2uv sv_add_arena sv_backoff sv_bless @@ -1038,6 +1052,7 @@ sv_cmp sv_cmp_locale sv_collxfrm sv_dec +sv_derived_from sv_dump sv_eq sv_free @@ -1070,6 +1085,7 @@ sv_setref_nv sv_setref_pv sv_setref_pvn sv_setsv +sv_setuv sv_taint sv_tainted sv_unmagic @@ -1082,6 +1098,7 @@ taint_proper too_few_arguments too_many_arguments unlnk +unshare_hek unsharepvn utilize wait4pid diff --git a/old_perl_exp.SH b/old_perl_exp.SH index e69de29bb2..637901b923 100755 --- a/old_perl_exp.SH +++ b/old_perl_exp.SH @@ -0,0 +1,52 @@ +#!/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 diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index b4ac75e949..b6564dffa9 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -64,16 +64,12 @@ $spitshell >>Makefile <<'!NO!SUBS!' # 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 diff --git a/os2/OS2/ExtAttr/Makefile.PL b/os2/OS2/ExtAttr/Makefile.PL index 4e8498f10c..35680288b8 100644 --- a/os2/OS2/ExtAttr/Makefile.PL +++ b/os2/OS2/ExtAttr/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; 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' diff --git a/os2/OS2/PrfDB/Makefile.PL b/os2/OS2/PrfDB/Makefile.PL index c591c0490c..39521685df 100644 --- a/os2/OS2/PrfDB/Makefile.PL +++ b/os2/OS2/PrfDB/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; 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' diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL index ff4deabef6..b7a295f857 100644 --- a/os2/OS2/Process/Makefile.PL +++ b/os2/OS2/Process/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; 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' diff --git a/os2/OS2/REXX/Makefile.PL b/os2/OS2/REXX/Makefile.PL index 07f6cc67ea..c27cb0d905 100644 --- a/os2/OS2/REXX/Makefile.PL +++ b/os2/OS2/REXX/Makefile.PL @@ -3,5 +3,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'OS2::REXX', VERSION => '0.2', + MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', ); @@ -244,7 +244,7 @@ register SV **sp; 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] == ':' @@ -296,7 +296,7 @@ int execf; 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 @@ -304,10 +304,10 @@ int execf; 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; } @@ -474,7 +474,7 @@ char *mode; # else char *shell = getenv("EMXSHELL"); - my_setenv("EMXSHELL", SH_PATH); + my_setenv("EMXSHELL", sh_path); res = popen(cmd, mode); my_setenv("EMXSHELL", shell); # endif @@ -724,8 +724,6 @@ os2error(int rc) return buf; } -char sh_path[STATIC_FILE_LENGTH+1] = SH_PATH_INI; - char * perllib_mangle(char *s, unsigned int l) { @@ -736,6 +734,8 @@ 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. */ @@ -747,6 +747,12 @@ perllib_mangle(char *s, unsigned int l) if (newl == 0 || oldl == 0) { die("Malformed PERLLIB_PREFIX"); } + strcpy(ret, newp); + s = ret; + while (*s) { + if (*s == '\\') *s = '/'; + s++; + } } else { notfound = 1; } @@ -763,7 +769,6 @@ perllib_mangle(char *s, unsigned int l) 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; } @@ -1102,17 +1107,20 @@ Perl_OS2_init() 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] = '/'; + } } } diff --git a/os2/os2ish.h b/os2/os2ish.h index 0597fdcd39..d83503d9b9 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -47,12 +47,6 @@ #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 @@ -197,9 +191,7 @@ extern OS2_Perl_data_t OS2_Perl_data; } #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); diff --git a/patchlevel.h b/patchlevel.h index 8dc52bc6f5..a2abcc16f7 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 9 +#define SUBVERSION 10 /* local_patches -- list of locally applied less-than-subversion patches. @@ -211,7 +211,7 @@ /* 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. */ @@ -244,6 +244,13 @@ #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 @@ -832,6 +839,7 @@ typedef struct magic MAGIC; 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; @@ -1157,6 +1165,14 @@ I32 unlnk _((char*)); # 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 @@ -1208,6 +1224,7 @@ EXT U32 origalen; 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 */ @@ -1480,7 +1497,6 @@ EXT I32 lex_formbrack; /* bracket count at outer format level */ 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/// */ diff --git a/perl_exp.SH b/perl_exp.SH index 1c1848b64a..17538634e1 100755 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -5,6 +5,9 @@ # 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. @@ -19,10 +22,11 @@ echo "#!" > perl.exp 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 @@ -30,6 +34,9 @@ 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 diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index df8d23fc1e..ba45e557b8 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -334,6 +334,23 @@ syscall() interface to access setitimer(2) if your system supports it, 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. @@ -2474,7 +2491,7 @@ in seconds, which may be fractional. Note: not all implementations are 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); @@ -3066,12 +3083,15 @@ Attempts to read LENGTH bytes of data into variable SCALAR from the 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 @@ -3093,10 +3113,11 @@ specified FILEHANDLE, using the system call write(2). It bypasses 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 @@ -758,11 +758,15 @@ PP(pp_left_shift) { 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; } } @@ -771,11 +775,15 @@ PP(pp_right_shift) { 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; } } @@ -932,7 +940,7 @@ PP(pp_bit_and) { 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 @@ -952,7 +960,7 @@ PP(pp_bit_xor) { 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 @@ -972,7 +980,7 @@ PP(pp_bit_or) { 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 @@ -1033,7 +1041,7 @@ PP(pp_complement) { dTOPss; if (SvNIOKp(sv)) { - UV value = ~(UV)SvIV(sv); + UV value = ~SvUV(sv); if (op->op_private & HINT_INTEGER) SETi( (IV)value ); else @@ -55,14 +55,14 @@ #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. */ @@ -110,12 +110,10 @@ #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)) @@ -98,10 +98,42 @@ static int dooneliner _((char *cmd, char *filename)); # 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. */ @@ -1077,6 +1109,8 @@ PP(pp_sysread) 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) @@ -1418,7 +1452,7 @@ PP(pp_flock) GV *gv; PerlIO *fp; -#if defined(HAS_FLOCK) || defined(flock) +#ifdef FLOCK argtype = POPi; if (MAXARG <= 0) gv = last_in_gv; @@ -1429,7 +1463,7 @@ PP(pp_flock) else fp = Nullfp; if (fp) { - value = (I32)(flock(PerlIO_fileno(fp), argtype) >= 0); + value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0); } else value = 0; @@ -2856,8 +2890,7 @@ PP(pp_system) 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) { @@ -2877,13 +2910,13 @@ PP(pp_system) 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; @@ -4079,7 +4112,42 @@ PP(pp_syscall) #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 @@ -4109,22 +4177,6 @@ PP(pp_syscall) # 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; @@ -4150,8 +4202,9 @@ int operation; 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; @@ -4163,4 +4216,5 @@ int operation; } return (i); } -#endif + +#endif /* LOCKF_EMULATE_FLOCK */ @@ -355,6 +355,10 @@ char* regnext _((char* p)); 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)); @@ -414,6 +418,7 @@ IV sv_2iv _((SV* sv)); 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)); @@ -0,0 +1,33 @@ +#! /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` @@ -0,0 +1,24 @@ +#! /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 @@ -1299,7 +1299,7 @@ register SV *sv; 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)) @@ -1317,6 +1317,81 @@ register SV *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; @@ -1648,22 +1723,20 @@ register SV *sstr; (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; @@ -1860,7 +1933,7 @@ register SV *sstr; * 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 */ @@ -2796,6 +2869,7 @@ I32 append; } if (!SvUPGRADE(sv, SVt_PV)) return 0; + SvSCREAM_off(sv); if (RsSNARF(rs)) { rsptr = NULL; @@ -3264,7 +3338,6 @@ newSVsv(old) register SV *old; { register SV *sv; - U32 oflags; if (!old) return Nullsv; @@ -3276,11 +3349,10 @@ register SV *old; 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); @@ -3448,30 +3520,40 @@ register SV *sv; } } } -#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 * @@ -155,6 +155,13 @@ struct xpviv { 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 */ @@ -412,6 +419,8 @@ struct xpvio { #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 @@ -480,6 +489,7 @@ struct xpvio { #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) @@ -487,6 +497,7 @@ char *sv_pvn _((SV *, STRLEN *)); 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) @@ -494,14 +505,25 @@ I32 SvTRUE _((SV *)); #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 \ @@ -520,6 +542,7 @@ I32 SvTRUE _((SV *)); : 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)) @@ -24,14 +24,20 @@ if ($ARGV[0] eq '') { `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; diff --git a/t/lib/posix.t b/t/lib/posix.t index 3adc602305..6ae88c0dd2 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -61,8 +61,10 @@ print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n"; # 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}) { @@ -1856,7 +1856,7 @@ yylex() 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++; @@ -2104,6 +2104,10 @@ yylex() 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 == '[') { @@ -2139,9 +2143,8 @@ yylex() } 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)) @@ -2170,6 +2173,8 @@ yylex() 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] = '%'; @@ -2842,10 +2847,10 @@ yylex() 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); @@ -2887,10 +2892,10 @@ yylex() 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); @@ -3218,16 +3223,16 @@ yylex() 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); @@ -4261,13 +4266,13 @@ I32 ck_uni; 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", @@ -4978,11 +4983,9 @@ start_subparse() CV* outsidecv = compcv; AV* comppadlist; -#ifndef __QNX__ if (compcv) { assert(SvTYPE(compcv) == SVt_PVCV); } -#endif save_I32(&subline); save_item(subname); SAVEI32(padix); @@ -42,6 +42,10 @@ # include <sys/file.h> #endif +#ifdef I_SYS_WAIT +# include <sys/wait.h> +#endif + #define FLUSH #ifdef LEAKTEST @@ -446,7 +450,7 @@ perl_new_collate(newcoll) ++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 { @@ -490,7 +494,7 @@ perl_new_numeric(newnum) 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; } } @@ -1778,13 +1782,127 @@ int newfd; } #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; @@ -1802,15 +1920,15 @@ PerlIO *ptr; #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 */ diff --git a/x2p/proto.h b/x2p/proto.h new file mode 100644 index 0000000000..eb5fb15b37 --- /dev/null +++ b/x2p/proto.h @@ -0,0 +1,8 @@ +/* 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. + * + */ |