[inseparable changes from patch from perl5.003_09 to perl5.003_10]
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>
Fri, 29 Nov 1996 17:31:00 +0000 (05:31 +1200)
committerChip Salzenberg <chip@atlantic.net>
Fri, 29 Nov 1996 17:31:00 +0000 (05:31 +1200)
 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)

48 files changed:
Changes
Configure
INSTALL
MANIFEST
Makefile.SH
README.qnx [new file with mode: 0644]
doio.c
doop.c
embed.h
ext/DB_File/DB_File.pm
ext/DB_File/DB_File.xs
ext/POSIX/POSIX.xs
ext/SDBM_File/sdbm/sdbm.h
global.sym
handy.h
hints/qnx.sh [new file with mode: 0644]
hv.c
hv.h
lib/ExtUtils/Embed.pm
lib/ExtUtils/xsubpp
malloc.c
mg.c
old_global.sym
old_perl_exp.SH
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
patchlevel.h
perl.h
perl_exp.SH
pod/perlfunc.pod
pp.c
pp.h
pp_sys.c
proto.h
qnx/ar
qnx/cpp
sv.c
sv.h
t/TEST
t/lib/posix.t
toke.c
util.c
x2p/proto.h [new file with mode: 0644]

diff --git a/Changes b/Changes
index 7ed1eed..9326ecf 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,6 +7,336 @@ site, in the .../src/5.0 directory for full version releases,
 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
 ----------------
index 5c0f48d..a7d224c 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -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
diff --git a/INSTALL b/INSTALL
index 81b3714..97c72cf 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -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.
index 80a439b..859da3c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 9052a4d..1a2d67d 100755 (executable)
@@ -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 (file)
index 0000000..0cfe353
--- /dev/null
@@ -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)
diff --git a/doio.c b/doio.c
index 5ad1e28..38f7c0d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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;
        }
     }
diff --git a/doop.c b/doop.c
index ddcaf36..dd162de 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -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);
diff --git a/embed.h b/embed.h
index faa1d5a..da0c709 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define seq_amg                Perl_seq_amg
 #define sge_amg                Perl_sge_amg
 #define sgt_amg                Perl_sgt_amg
+#define sh_path                Perl_sh_path
 #define sig_name       Perl_sig_name
 #define sig_num                Perl_sig_num
 #define sighandler     Perl_sighandler
 #define yytable                Perl_yytable
 #define yyval          Perl_yyval
 #define Gv_AMupdate    Perl_Gv_AMupdate
+#define SvTRUE         Perl_SvTRUE
+#define SvIV           Perl_SvIV
+#define SvUV           Perl_SvUV
+#define SvNV           Perl_SvNV
 #define amagic_call    Perl_amagic_call
 #define append_elem    Perl_append_elem
 #define append_list    Perl_append_list
 #define regprop                Perl_regprop
 #define repeatcpy      Perl_repeatcpy
 #define rninstr                Perl_rninstr
+#define rsignal                Perl_rsignal
+#define rsignal_save   Perl_rsignal_save
+#define rsignal_state  Perl_rsignal_state
+#define rsignal_restore        Perl_rsignal_restore
 #define runops         Perl_runops
 #define safecalloc     Perl_safecalloc
 #define safemalloc     Perl_safemalloc
 #define screaminstr    Perl_screaminstr
 #define setdefout      Perl_setdefout
 #define setenv_getix   Perl_setenv_getix
+#define share_hek      Perl_share_hek
 #define sharepvn       Perl_sharepvn
 #define sighandler     Perl_sighandler
 #define skipspace      Perl_skipspace
 #define sv_2mortal     Perl_sv_2mortal
 #define sv_2nv         Perl_sv_2nv
 #define sv_2pv         Perl_sv_2pv
+#define sv_2uv         Perl_sv_2uv
 #define sv_add_arena   Perl_sv_add_arena
 #define sv_backoff     Perl_sv_backoff
 #define sv_bless       Perl_sv_bless
 #define sv_newmortal   Perl_sv_newmortal
 #define sv_newref      Perl_sv_newref
 #define sv_peek                Perl_sv_peek
+#define sv_pvn         Perl_sv_pvn
 #define sv_pvn_force   Perl_sv_pvn_force
 #define sv_ref         Perl_sv_ref
 #define sv_reftype     Perl_sv_reftype
 #define too_few_arguments      Perl_too_few_arguments
 #define too_many_arguments     Perl_too_many_arguments
 #define unlnk          Perl_unlnk
+#define unshare_hek    Perl_unshare_hek
 #define unsharepvn     Perl_unsharepvn
 #define utilize                Perl_utilize
 #define wait4pid       Perl_wait4pid
index fcc84c3..f62de2e 100644 (file)
@@ -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
index 3832a26..f7dc378 100644 (file)
@@ -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 ;
 {
index a94c942..e4aa293 100644 (file)
@@ -33,7 +33,6 @@
 #if defined(I_TERMIOS)
 #include <termios.h>
 #endif
-#include <stdio.h>
 #ifdef I_STDLIB
 #include <stdlib.h>
 #endif
index c05f0d0..11967ec 100644 (file)
@@ -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. */
index ca7240a..729aa18 100644 (file)
@@ -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
diff --git a/handy.h b/handy.h
index 2db267d..b6350a9 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -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 (file)
index 0000000..e0ce55c
--- /dev/null
@@ -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     
diff --git a/hv.c b/hv.c
index 50d5881..b25c2e2 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -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);
 }
 
 
diff --git a/hv.h b/hv.h
index 746e428..c8d8be6 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -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
index 9783292..c4a3c68 100644 (file)
@@ -222,7 +222,7 @@ sub ccdlflags {
 }
 
 sub perl_inc {
-   print " -I$Config{archlib}/CORE ";
+   print " -I$Config{archlibexp}/CORE ";
 }
 
 sub ccopts {
index 6823955..70796bd 100755 (executable)
@@ -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
index 170ae3e..6ebe919 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -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--;
        }
diff --git a/mg.c b/mg.c
index 8c678f4..3086e73 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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);
     }
index b63df1c..5c7409d 100644 (file)
@@ -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
index e69de29..637901b 100755 (executable)
@@ -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
index b4ac75e..b6564df 100644 (file)
@@ -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
 
index 4e8498f..3568028 100644 (file)
@@ -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' 
index c591c04..3952168 100644 (file)
@@ -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' 
index ff4deab..b7a295f 100644 (file)
@@ -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' 
index 07f6cc6..c27cb0d 100644 (file)
@@ -3,5 +3,6 @@ use ExtUtils::MakeMaker;
 WriteMakefile(
              NAME => 'OS2::REXX',
              VERSION => '0.2',
+             MAN3PODS  => ' ',         # Pods will be built by installman.
              XSPROTOARG => '-noprototypes',
 );
index a35b706..14a6ea0 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -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] = '/';
+       }
     }
 }
 
index 0597fdc..d83503d 100644 (file)
 
 #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);
 
index 8dc52bc..a2abcc1 100644 (file)
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 3
-#define SUBVERSION 9
+#define SUBVERSION 10
 
 /*
        local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.h b/perl.h
index f740c9a..16c119e 100644 (file)
--- a/perl.h
+++ b/perl.h
 /* Use all the "standard" definitions? */
 #if defined(STANDARD_C) && defined(I_STDLIB)
 #   include <stdlib.h>
-#endif /* STANDARD_C */
+#endif
 
 /* This comes after <stdlib.h> so we don't try to change the standard
  * library prototypes; we'll use our own in proto.h instead. */
 
 #define MEM_SIZE Size_t
 
+#if defined(STANDARD_C) && defined(I_STDDEF)
+#   include <stddef.h>
+#   define OFFSETOF(s,m)  offsetof(s,m)
+#else
+#   define OFFSETOF(s,m)  (Size_t)(&(((s *)0)->m))
+#endif
+
 #if defined(I_STRING) || defined(__cplusplus)
 #   include <string.h>
 #else
@@ -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/// */
index 1c1848b..1753863 100755 (executable)
@@ -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
index df8d23f..ba45e55 100644 (file)
@@ -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
 
diff --git a/pp.c b/pp.c
index 4f04eb6..48ca9bb 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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
diff --git a/pp.h b/pp.h
index a3b9ac9..56cd26c 100644 (file)
--- a/pp.h
+++ b/pp.h
 #define POPp           (SvPVx(POPs, na))
 #define POPn           (SvNVx(POPs))
 #define POPi           ((IV)SvIVx(POPs))
-#define POPu           ((UV)SvIVx(POPs))
+#define POPu           ((UV)SvUVx(POPs))
 #define POPl           ((long)SvIVx(POPs))
 
 #define TOPs           (*sp)
 #define TOPp           (SvPV(TOPs, na))
 #define TOPn           (SvNV(TOPs))
 #define TOPi           ((IV)SvIV(TOPs))
-#define TOPu           ((UV)SvIV(TOPs))
+#define TOPu           ((UV)SvUV(TOPs))
 #define TOPl           ((long)SvIV(TOPs))
 
 /* Go to some pains in the rare event that we must extend the stack. */
 #define dPOPPOPssrl    SV *right = POPs; SV *left = POPs
 #define dPOPPOPnnrl    double right = POPn; double left = POPn
 #define dPOPPOPiirl    IV right = POPi; IV left = POPi
-#define dPOPPOPuurl    UV right = POPu; UV left = POPu
 
 #define dPOPTOPssrl    SV *right = POPs; SV *left = TOPs
 #define dPOPTOPnnrl    double right = POPn; double left = TOPn
 #define dPOPTOPiirl    IV right = POPi; IV left = TOPi
-#define dPOPTOPuurl    UV right = POPu; UV left = TOPu
 
 #define RETPUSHYES     RETURNX(PUSHs(&sv_yes))
 #define RETPUSHNO      RETURNX(PUSHs(&sv_no))
index d580fba..8af0072 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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 */
diff --git a/proto.h b/proto.h
index 3b89d99..b332373 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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));
diff --git a/qnx/ar b/qnx/ar
index e69de29..b46549a 100755 (executable)
--- a/qnx/ar
+++ b/qnx/ar
@@ -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`
diff --git a/qnx/cpp b/qnx/cpp
index e69de29..6459af2 100755 (executable)
--- a/qnx/cpp
+++ b/qnx/cpp
@@ -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
diff --git a/sv.c b/sv.c
index e9580c2..03d32a8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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 *
diff --git a/sv.h b/sv.h
index 3fb7127..06bf356 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -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))
diff --git a/t/TEST b/t/TEST
index 4ef50ea..0b996f4 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -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;
index 3adc602..6ae88c0 100755 (executable)
@@ -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}) {
diff --git a/toke.c b/toke.c
index b4c4d9e..7dd35cb 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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);
diff --git a/util.c b/util.c
index 22bda3f..6630b07 100644 (file)
--- a/util.c
+++ b/util.c
 #  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 (file)
index 0000000..eb5fb15
--- /dev/null
@@ -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.
+ *
+ */