From: Perl 5 Porters Date: Fri, 29 Nov 1996 17:31:00 +0000 (+1200) Subject: [inseparable changes from patch from perl5.003_09 to perl5.003_10] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff68c7194e176ca1907544a3a65684b76834d0fe;p=p5sagit%2Fp5-mst-13.2.git [inseparable changes from patch from perl5.003_09 to perl5.003_10] CORE LANGUAGE CHANGES Subject: Allow &{sub {...}} without warning From: Chip Salzenberg Files: toke.c Subject: Make parens optional on [gs]ethost and [gs]et{pw,gr} function From: Chip Salzenberg Files: toke.c Subject: Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}" From: Chip Salzenberg Files: toke.c DOCUMENTATION Subject: Improve documentation for sysread() and syswrite() From: Chip Salzenberg 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 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 Files: hv.c hv.h perl.h Subject: Undo broken perf. patch (PADTMP stealing) From: Chip Salzenberg Files: sv.c Subject: Make SV unstudied in sv_gets() From: Chip Salzenberg Files: sv.c Subject: 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 Subject: Minor locale cleanups From: Chip Salzenberg 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 Files: doop.c Subject: Fix spurious warning from bitwise string ops From: Chip Salzenberg Files: doop.c Subject: Eliminate warning on {,sys}read(,$newvar,) From: Chip Salzenberg Files: doop.c pp_sys.c Subject: Namespace cleanup From: Chip Salzenberg Files: global.sym old_global.sym perl.h Subject: Modify perl_exp.SH; create old_perl_exp.SH; document old_* From: Chip Salzenberg 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 Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c Msg-ID: (applied based on p5p patch as commit 679728958e74b0ccd6d61567d84851f1ef994e1f) Subject: Emulate missing flock() with either fcntl() or lockf() From: Chip Salzenberg 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 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 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) --- diff --git a/Changes b/Changes index 7ed1eed..9326ecf 100644 --- a/Changes +++ b/Changes @@ -8,6 +8,336 @@ or in the .../src/5/0/unsupported directory for sub-version releases.) ---------------- +Version 5.003_10 +---------------- + +This patch is closing in on 5.004. It contains lots of small and +valuable changes, but nothing dramatic. + + CORE LANGUAGE CHANGES + + Title: "Allow &{sub {...}} without warning" + From: Chip Salzenberg + Files: toke.c + + Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} function + From: Chip Salzenberg + Files: toke.c + + Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"" + From: Chip Salzenberg + Files: toke.c + + OTHER CORE CHANGES + + Title: "Fix regex matching of chars with high bit set" + From: Chip Salzenberg + Files: regexec.c + + Title: "Hash key memory corruption fix and naming cleanup" + From: Chip Salzenberg + Files: hv.c hv.h perl.h + + Title: "Undo broken perf. patch (PADTMP stealing)" + From: Chip Salzenberg + Files: sv.c + + Title: "Make SV unstudied in sv_gets()" + From: Chip Salzenberg + 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 + Files: t/lib/posix.t util.c + + Title: "Always taint result of sprintf() on float" + From: Chip Salzenberg + Files: doop.c + + Title: "Fix spurious warning from bitwise string ops" + From: Chip Salzenberg + Files: doop.c + + Title: "Eliminate warning on {,sys}read(,$newvar,)" + From: Chip Salzenberg + Files: doop.c pp_sys.c + + Title: "Don't call fcntl(fileno(rsfp)) if !rsfp" + From: Chip Salzenberg + Files: perl.c + + Title: "Save message when calling __DIE__ hook" + From: Chip Salzenberg + Files: pp_ctl.c + + Title: "Namespace cleanup" + From: Chip Salzenberg + Files: global.sym old_global.sym perl.h + + Title: "Modify perl_exp.SH; create old_perl_exp.SH; document old_*" + From: Chip Salzenberg + Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH + + PORTABILITY + + Title: "Reliable signal patch" + From: Kenneth Albanowski + Msg-ID: + 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 + Files: pp_sys.c + + Title: "3_09: minor patches for OS/2" + From: Ilya Zakharevich + 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 + 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 + 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 + Files: lib/diagnostics.pm pod/perldiag.pod + + DOCUMENTATION + + Title: "Improve documentation for sysread() and syswrite()" + From: Chip Salzenberg + Files: pod/perlfunc.pod + + Title: "Document how to use $SIG{ALRM} and alarm()" + From: Roderick Schertler + 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) + From: Chip Salzenberg + 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 + Files: many... but mostly perly.y and toke.c + + Title: "Re: memory corruption / security bug in sysread,syswrite + pa + From: Jarkko Hietaniemi + 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 + Files: Configure + + Title: "Properly prototype safe{malloc,calloc,realloc,free}." + From: Chip Salzenberg + Files: proto.h + + Title: "UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1, + From: John Hughes + 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 + 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 + Files: embed.pl + + Title: "Add new symbols to old_global.sym, too." + From: Chip Salzenberg + Files: global.sym old_global.sym + + Title: "Cleanup of {,un}pack('w')." + From: Chip Salzenberg + Files: pp.c + + Title: "Cleanups from Ilya." + From: Chip Salzenberg + Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c + + Title: "Fix for unpack('w') on 64-bit systems." + From: Chip Salzenberg + Files: pp.c + + Title: "Re: LC_NUMERIC support is ready + performance" + From: Ilya Zakharevich + 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 + Files: hv.c hv.h proto.h + + Title: "Mortal stack pre-allocation from Ilya." + From: Chip Salzenberg + 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 + 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 + 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 + 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 + Files: t/lib/db-hash.t + + Title: "Update documentation and warning in I18N::Collate." + From: Chip Salzenberg + Files: lib/I18N/Collate.pm + + Title: "Fix bitwise op test; clean up a couple of others" + From: Chip Salzenberg + Files: t/lib/bigintpm.t t/op/bop.t t/op/overload.t + + Title: "minimal timelocal.pl for _09" + From: Achim Bohnet + 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 + 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 + 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" + Msg-ID: + Files: pod/perli18n.pod + + BUNDLED UTILITIES + + Title: "Fix type mismatches in x2p's safe{alloc,realloc,free}." + From: Chip Salzenberg + Files: x2p/util.c + + +---------------- Version 5.003_08 ---------------- diff --git a/Configure b/Configure index 5c0f48d..a7d224c 100755 --- 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}' 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 --- 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 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. diff --git a/MANIFEST b/MANIFEST index 80a439b..859da3c 100644 --- 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 diff --git a/Makefile.SH b/Makefile.SH index 9052a4d..1a2d67d 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -401,7 +401,16 @@ clean: done rm -f perl suidperl miniperl $(LIBPERL) -realclean: clean +realclean: clean _cleaner + @echo "Note that make realclean does not delete config.sh" + +clobber: clean _cleaner + rm -f config.sh cppstdin + +distclean: clobber + +# Do not 'make _cleaner' directly. +_cleaner: -cd os2; rm -f Makefile -cd pod; $(MAKE) realclean -cd utils; $(MAKE) realclean @@ -417,12 +426,6 @@ realclean: clean rm -f lib/.exists rm -f h2ph.man pstruct rm -rf .config - @echo "Note that make realclean does not delete config.sh" - -clobber: realclean - rm -f config.sh cppstdin - -distclean: clobber # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. diff --git a/README.qnx b/README.qnx new file mode 100644 index 0000000..0cfe353 --- /dev/null +++ b/README.qnx @@ -0,0 +1,22 @@ +README.qnx + +Please see hints/qnx.sh for more detailed information about compiling +perl under QNX4. + +The files in the "qnx" directory are: + + * "qnx/ar" is a script that emulates the standard unix archive (aka + library) utility. Under Watcom 10.6, ar is linked to wlib and + provides the expected interface. With Watcom 9.5, a cover function + is required. This one is fairly crude but has proved adequate for + compiling perl. A more thorough version is available at: + + http://www.fdma.com/pub/qnx/porting/ar + + * "qnx/cpp" is a script that provides C preprocessing functionality. + Configure can generate a similar cover, but it doesn't handle all + the command-line options that perl throws at it. This might be + reasonably placed in /usr/local/bin. + +-- +Norton T. Allen (allen@huarp.harvard.edu) diff --git a/doio.c b/doio.c index 5ad1e28..38f7c0d 100644 --- 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 --- 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 --- a/embed.h +++ b/embed.h @@ -237,6 +237,7 @@ #define seq_amg Perl_seq_amg #define sge_amg Perl_sge_amg #define sgt_amg Perl_sgt_amg +#define sh_path Perl_sh_path #define sig_name Perl_sig_name #define sig_num Perl_sig_num #define sighandler Perl_sighandler @@ -312,6 +313,10 @@ #define yytable Perl_yytable #define yyval Perl_yyval #define Gv_AMupdate Perl_Gv_AMupdate +#define SvTRUE Perl_SvTRUE +#define SvIV Perl_SvIV +#define SvUV Perl_SvUV +#define SvNV Perl_SvNV #define amagic_call Perl_amagic_call #define append_elem Perl_append_elem #define append_list Perl_append_list @@ -992,6 +997,10 @@ #define regprop Perl_regprop #define repeatcpy Perl_repeatcpy #define rninstr Perl_rninstr +#define rsignal Perl_rsignal +#define rsignal_save Perl_rsignal_save +#define rsignal_state Perl_rsignal_state +#define rsignal_restore Perl_rsignal_restore #define runops Perl_runops #define safecalloc Perl_safecalloc #define safemalloc Perl_safemalloc @@ -1049,6 +1058,7 @@ #define screaminstr Perl_screaminstr #define setdefout Perl_setdefout #define setenv_getix Perl_setenv_getix +#define share_hek Perl_share_hek #define sharepvn Perl_sharepvn #define sighandler Perl_sighandler #define skipspace Perl_skipspace @@ -1063,6 +1073,7 @@ #define sv_2mortal Perl_sv_2mortal #define sv_2nv Perl_sv_2nv #define sv_2pv Perl_sv_2pv +#define sv_2uv Perl_sv_2uv #define sv_add_arena Perl_sv_add_arena #define sv_backoff Perl_sv_backoff #define sv_bless Perl_sv_bless @@ -1094,6 +1105,7 @@ #define sv_newmortal Perl_sv_newmortal #define sv_newref Perl_sv_newref #define sv_peek Perl_sv_peek +#define sv_pvn Perl_sv_pvn #define sv_pvn_force Perl_sv_pvn_force #define sv_ref Perl_sv_ref #define sv_reftype Perl_sv_reftype @@ -1123,6 +1135,7 @@ #define too_few_arguments Perl_too_few_arguments #define too_many_arguments Perl_too_many_arguments #define unlnk Perl_unlnk +#define unshare_hek Perl_unshare_hek #define unsharepvn Perl_unsharepvn #define utilize Perl_utilize #define wait4pid Perl_wait4pid diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index fcc84c3..f62de2e 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 10th Nov 1996 -# version 1.05 +# last modified 27th Nov 1996 +# version 1.06 package DB_File::HASHINFO ; @@ -149,7 +149,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ; use Carp; -$VERSION = "1.05" ; +$VERSION = "1.06" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -1518,6 +1518,10 @@ Made all scripts in the documentation C and C<-w> clean. Added logic to F to allow the module to be built after Perl is installed. +=item 1.06 + +Minor namespace cleanup: Localized C. + =back =head1 BUGS diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 3832a26..f7dc378 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 10th Nov 1996 - version 1.05 + last modified 27th Nov 1996 + version 1.06 All comments/suggestions/problems are welcome @@ -27,6 +27,7 @@ Dave Hammen, hammen@gothamcity.jsc.nasa.gov 1.05 - Added logic to allow prefix & hash types to be specified via Makefile.PL + 1.06 - Minor namespace cleanup: Localized PrintBtree. */ @@ -273,6 +274,7 @@ RECNOINFO * recno ; printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ; } +static void PrintBtree(btree) BTREEINFO * btree ; { diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index a94c942..e4aa293 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -33,7 +33,6 @@ #if defined(I_TERMIOS) #include #endif -#include #ifdef I_STDLIB #include #endif diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index c05f0d0..11967ec 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -79,15 +79,15 @@ extern DBM *sdbm_prep proto((char *, char *, int, int)); extern long sdbm_hash proto((char *, int)); #ifndef SDBM_ONLY -#define dbm_open sdbm_open; -#define dbm_close sdbm_close; -#define dbm_fetch sdbm_fetch; -#define dbm_store sdbm_store; -#define dbm_delete sdbm_delete; -#define dbm_firstkey sdbm_firstkey; -#define dbm_nextkey sdbm_nextkey; -#define dbm_error sdbm_error; -#define dbm_clearerr sdbm_clearerr; +#define dbm_open sdbm_open +#define dbm_close sdbm_close +#define dbm_fetch sdbm_fetch +#define dbm_store sdbm_store +#define dbm_delete sdbm_delete +#define dbm_firstkey sdbm_firstkey +#define dbm_nextkey sdbm_nextkey +#define dbm_error sdbm_error +#define dbm_clearerr sdbm_clearerr #endif /* Most of the following is stolen from perl.h. */ diff --git a/global.sym b/global.sym index ca7240a..729aa18 100644 --- a/global.sym +++ b/global.sym @@ -221,6 +221,7 @@ scrgv seq_amg sge_amg sgt_amg +sh_path sig_name sig_num sighandler @@ -299,6 +300,10 @@ yyval # Functions Gv_AMupdate +SvTRUE +SvIV +SvUV +SvNV amagic_call append_elem append_list @@ -979,6 +984,10 @@ regnext regprop repeatcpy rninstr +rsignal +rsignal_save +rsignal_state +rsignal_restore runops safecalloc safemalloc @@ -1036,6 +1045,7 @@ scope screaminstr setdefout setenv_getix +share_hek sharepvn sighandler skipspace @@ -1050,6 +1060,7 @@ sv_2iv sv_2mortal sv_2nv sv_2pv +sv_2uv sv_add_arena sv_backoff sv_bless @@ -1081,6 +1092,7 @@ sv_mortalcopy sv_newmortal sv_newref sv_peek +sv_pvn sv_pvn_force sv_ref sv_reftype @@ -1110,6 +1122,7 @@ taint_proper too_few_arguments too_many_arguments unlnk +unshare_hek unsharepvn utilize wait4pid diff --git a/handy.h b/handy.h index 2db267d..b6350a9 100644 --- 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 index 0000000..e0ce55c --- /dev/null +++ b/hints/qnx.sh @@ -0,0 +1,176 @@ +#---------------------------------------------------------------- +# QNX hints +# +# As of perl5.003_09, perl5 will compile without errors +# and pass almost all the tests in the test suite. The remaining +# failures have been identified as bugs in the Watcom libraries +# which I hope will be fixed in the near future. +# +# As with many unix ports, this one depends on a few "standard" +# unix utilities which are not necessarily standard for QNX. +# +# /bin/sh This is used heavily by Configure and then by +# perl itself. QNX's version is fine, but Configure +# will choke on the 16-bit version, so if you are +# running QNX 4.22, link /bin/sh to /bin32/ksh +# ar This is the standard unix library builder. +# We use wlib. With Watcom 10.6, when wlib is +# linked as "ar", it behaves like ar and all is +# fine. Under 9.5, a cover is required. One is +# included in ../qnx +# nm This is used (optionally) by configure to list +# the contents of libraries. I will generate +# a cover function on the fly in the UU directory. +# cpp Configure and perl need a way to invoke a C +# preprocessor. I have created a simple cover +# for cc which does the right thing. Without this, +# Configure will create it's own wrapper which works, +# but it doesn't handle some of the command line arguments +# that perl will throw at it. +# make You really need GNU make to compile this. GNU make +# ships by default with QNX 4.23, but you can get it +# from quics for earlier versions. +#---------------------------------------------------------------- +# Outstanding Issues: +# lib/posix.t test fails on test 17 because acos(1) != 0. +# Watcom promises to fix this in next release. +# lib/io_udp.t test hangs because of a bug in getsockname(). +# Fixed in latest BETA socket3r.lib +# If there is a softlink in your path, Findbin will fail. +# This is a documented feature of getpwd(). +# There is currently no support for dynamically linked +# libraries. +#---------------------------------------------------------------- +# At present, all QNX systems are equivalent architectures, +# so it might be reasonable to call archname=qnx rather than +# making an unnecessary distinction between AT-qnx and PCI-qnx, +# for example. +#---------------------------------------------------------------- +# These hints were submitted by: +# Norton T. Allen +# Harvard University Atmospheric Research Project +# allen@huarp.harvard.edu +# +# If you have suggestions or changes, please let me know. +#---------------------------------------------------------------- + +#---------------------------------------------------------------- +# QNX doesn't come with a csh and the ports of tcsh I've used +# don't work reliably: +#---------------------------------------------------------------- +csh='' +d_csh='undef' +full_csh='' + +#---------------------------------------------------------------- +# difftime is implemented as a preprocessor macro, so it doesn't show +# up in the libraries: +#---------------------------------------------------------------- +d_difftime='define' + +#---------------------------------------------------------------- +# strtod is in the math library, but we can't tell Configure +# about the math library or it will confuse the linker +#---------------------------------------------------------------- +d_strtod='define' + +#---------------------------------------------------------------- +# The following exist in the libraries, but there are no +# prototypes available: +#---------------------------------------------------------------- +d_setregid='undef' +d_setreuid='undef' +d_setlinebuf='undef' +d_truncate='undef' +d_getpgid='undef' + +lib_ext='3r.lib' +libc='/usr/lib/clib3r.lib' + +#---------------------------------------------------------------- +# ccflags: +# I like to turn the warnings up high, but a few common +# constructs make a lot of noise, so I turn those warnings off. +# A few still remain... +# +# HIDEMYMALLOC is necessary if using mymalloc since it is very +# tricky (though not impossible) to totally replace the watcom +# malloc/free set. +# +# unix.h is required as a general rule for unixy applications. +#---------------------------------------------------------------- +ccflags='-DHIDEMYMALLOC -mf -w4 -Wc,-wcd=202 -Wc,-wcd=203 -Wc,-wcd=302 -Wc,-fi=unix.h' + +#---------------------------------------------------------------- +# ldflags: +# If you want debugging information, you must specify -g on the +# link as well as the compile. If optimize != -g, you should +# remove this. +#---------------------------------------------------------------- +ldflags="-g" + +so='none' +selecttype='fd_set *' + +#---------------------------------------------------------------- +# Add -lunix to list of libs. This is needed mainly so the nm +# search will find funcs in the unix lib. Including unix.h should +# automatically include the library without -l. +#---------------------------------------------------------------- +libswanted="$libswanted unix" + +if [ -z "`which ar 2>/dev/null`" ]; then + cat <<-'EOF' + I don't see an 'ar', so I'm guessing you are running + Watcom 9.5 or earlier. You may want to install the ar + cover found in the qnx subdirectory of this distribution. + It might reasonably be placed in /usr/local/bin. + + EOF +fi +#---------------------------------------------------------------- +# Here is a nm script which fixes up wlib's output to look +# something like nm's, at least enough so that Configure can +# use it. +#---------------------------------------------------------------- +if [ -z "`which nm 2>/dev/null`" ]; then + cat <<-EOF + Creating a quick-and-dirty nm cover for Configure to use: + + EOF + cat >../UU/nm <<-'EOF' + #! /bin/sh + #__USAGE + #%C [ ...] + # 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 --- 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 --- 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 diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index 9783292..c4a3c68 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -222,7 +222,7 @@ sub ccdlflags { } sub perl_inc { - print " -I$Config{archlib}/CORE "; + print " -I$Config{archlibexp}/CORE "; } sub ccopts { diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 6823955..70796bd 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -76,7 +76,7 @@ perl(1), perlxs(1), perlxstut(1), perlxs(1) =cut # Global Constants -$XSUBPP_version = "1.939"; +$XSUBPP_version = "1.940"; require 5.002; use vars '$cplusplus'; @@ -95,7 +95,7 @@ $ProtoUsed = 0 ; SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { $flag = shift @ARGV; $flag =~ s/^-// ; - $spat = shift, next SWITCH if $flag eq 's'; + $spat = quotemeta shift, next SWITCH if $flag eq 's'; $cplusplus = 1, next SWITCH if $flag eq 'C++'; $WantPrototypes = 0, next SWITCH if $flag eq 'noprototypes'; $WantPrototypes = 1, next SWITCH if $flag eq 'prototypes'; @@ -661,6 +661,7 @@ sub fetch_para { $Module = $1; $Package = defined($2) ? $2 : ''; # keep -w happy $Prefix = defined($3) ? $3 : ''; # keep -w happy + $Prefix = quotemeta $Prefix ; ($Module_cname = $Module) =~ s/\W/_/g; ($Packid = $Package) =~ tr/:/_/; $Packprefix = $Package; @@ -791,12 +792,13 @@ while (fetch_para()) { ($class, $func_name, $orig_args) = ($1, $2, $3) ; ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; - $Full_func_name = "${Packid}_$func_name"; + ($clean_func_name = $func_name) =~ s/^$Prefix//; + $Full_func_name = "${Packid}_$clean_func_name"; # Check for duplicate function definition for $tmp (@XSStack) { next unless defined $tmp->{functions}{$Full_func_name}; - Warn("Warning: duplicate function definition '$func_name' detected"); + Warn("Warning: duplicate function definition '$clean_func_name' detected"); last; } $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ; @@ -840,7 +842,7 @@ while (fetch_para()) { # print function header print Q<<"EOF"; -#XS(XS_${Packid}_$func_name) +#XS(XS_${Full_func_name}) #[[ # dXSARGS; EOF diff --git a/malloc.c b/malloc.c index 170ae3e..6ebe919 100644 --- 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 --- 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); } diff --git a/old_global.sym b/old_global.sym index b63df1c..5c7409d 100644 --- a/old_global.sym +++ b/old_global.sym @@ -34,7 +34,6 @@ compcv comppad comppad_name comppad_name_fill -comppad_name_floor concat_amg concat_ass_amg cop_seqmax @@ -48,12 +47,10 @@ curinterp curpad cv_const_sv dc -debug dec_amg di div_amg div_ass_amg -do_undump ds egid envgv @@ -213,6 +210,7 @@ scrgv seq_amg sge_amg sgt_amg +sh_path sig_name sig_num siggv @@ -250,10 +248,12 @@ vtbl_collxfrm vtbl_dbline vtbl_env vtbl_envelem +vtbl_fm vtbl_glob vtbl_isa vtbl_isaelem vtbl_mglob +vtbl_nkeys vtbl_pack vtbl_packelem vtbl_pos @@ -317,6 +317,7 @@ cast_ulong check_uni checkcomma ck_aelem +ck_bitop ck_concat ck_delete ck_eof @@ -425,11 +426,13 @@ gv_HVadd gv_IOadd gv_check gv_efullname +gv_efullname3 gv_fetchfile gv_fetchmeth gv_fetchmethod gv_fetchpv gv_fullname +gv_fullname3 gv_init gv_stashpv gv_stashpvn @@ -451,6 +454,7 @@ hv_iterkeysv hv_iternext hv_iternextsv hv_iterval +hv_ksplit hv_magic hv_stashpv hv_store @@ -491,12 +495,14 @@ magic_set magic_setamagic magic_setarylen magic_setbm +magic_setfm magic_setcollxfrm magic_setdbline magic_setenv magic_setglob magic_setisa magic_setmglob +magic_setnkeys magic_setpack magic_setpos magic_setsig @@ -507,6 +513,7 @@ magic_setvec magic_wipepack magicname markstack_grow +mem_collxfrm mess mg_clear mg_copy @@ -962,8 +969,13 @@ regnext regprop repeatcpy rninstr +rsignal +rsignal_save +rsignal_state +rsignal_restore runops same_dirent +save_I16 save_I32 save_aptr save_ary @@ -1010,6 +1022,7 @@ scope screaminstr setdefout setenv_getix +share_hek sharepvn sighandler skipspace @@ -1024,6 +1037,7 @@ sv_2iv sv_2mortal sv_2nv sv_2pv +sv_2uv sv_add_arena sv_backoff sv_bless @@ -1038,6 +1052,7 @@ sv_cmp sv_cmp_locale sv_collxfrm sv_dec +sv_derived_from sv_dump sv_eq sv_free @@ -1070,6 +1085,7 @@ sv_setref_nv sv_setref_pv sv_setref_pvn sv_setsv +sv_setuv sv_taint sv_tainted sv_unmagic @@ -1082,6 +1098,7 @@ taint_proper too_few_arguments too_many_arguments unlnk +unshare_hek unsharepvn utilize wait4pid diff --git a/old_perl_exp.SH b/old_perl_exp.SH index e69de29..637901b 100755 --- a/old_perl_exp.SH +++ b/old_perl_exp.SH @@ -0,0 +1,52 @@ +#!/bin/sh + +# Written: Nov 1994 Wayne Scott (wscott@ichips.intel.com) + +# Create the export list for perl based on 'old_global.sym'. +# Needed by AIX to do dynamic linking. + +# This simple program relys on 'old_global.sym' being up to date +# with all of the global symbols that a dynamicly link library +# might want to access. + +# All symbols have a Perl_ prefix because that's what embed.h +# sticks in front of them. + +echo "Extracting perl.exp" + +rm -f perl.exp +echo "#!" > perl.exp + +sed -n '/^[A-Za-z]/ s/^/Perl_/p' old_global.sym >> perl.exp + +# +# also add symbols from interp.sym +# They are only needed if -DMULTIPLICITY is not set but it +# doesn't hurt to include them anyway. +sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp + +# extra globals not included above. +cat <> perl.exp +perl_init_i18nl10n +perl_init_i18nl14n +perl_new_collate +perl_new_ctype +perl_new_numeric +perl_numeric_local +perl_numeric_standard +perl_alloc +perl_construct +perl_destruct +perl_free +perl_parse +perl_run +perl_get_sv +perl_get_av +perl_get_hv +perl_get_cv +perl_call_argv +perl_call_pv +perl_call_method +perl_call_sv +perl_requirepv +END diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index b4ac75e..b6564df 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -64,16 +64,12 @@ $spitshell >>Makefile <<'!NO!SUBS!' # grep -v '"\(malloc\|realloc\|free\)"' perl.linkexp >>$@ -# We assume here that perl is available somewhere ... - perl.exports: perl.exp EXTERN.h perl.h - (echo '#include "EXTERN.h"'; echo '#include "perl.h"' ; \ - echo '#include "perl.exp"') | \ + (echo "#include \"EXTERN.h\" \n#include \"perl.h\" \n#include \"perl.exp\""; \ + echo "malloc\nrealloc\ncalloc\nfree") | \ $(CC) -DEMBED -E - | \ awk '{if ($$2 == "") print $$1}' | sort | uniq > $@ -# perl -ne 'print if (/^#!/ .. /^#\s/) && s/^(\w+) *$$/$$1/' > $@ - perl.linkexp: perl.exports perl.map cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/ "\0"/' > perl.linkexp diff --git a/os2/OS2/ExtAttr/Makefile.PL b/os2/OS2/ExtAttr/Makefile.PL index 4e8498f..3568028 100644 --- a/os2/OS2/ExtAttr/Makefile.PL +++ b/os2/OS2/ExtAttr/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'OS2::ExtAttr', 'VERSION_FROM' => 'ExtAttr.pm', # finds $VERSION + MAN3PODS => ' ', # Pods will be built by installman. 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' diff --git a/os2/OS2/PrfDB/Makefile.PL b/os2/OS2/PrfDB/Makefile.PL index c591c04..3952168 100644 --- a/os2/OS2/PrfDB/Makefile.PL +++ b/os2/OS2/PrfDB/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'OS2::PrfDB', 'VERSION_FROM' => 'PrfDB.pm', # finds $VERSION + MAN3PODS => ' ', # Pods will be built by installman. 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL index ff4deab..b7a295f 100644 --- a/os2/OS2/Process/Makefile.PL +++ b/os2/OS2/Process/Makefile.PL @@ -4,6 +4,7 @@ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'OS2::Process', 'VERSION' => '0.1', + MAN3PODS => ' ', # Pods will be built by installman. 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' diff --git a/os2/OS2/REXX/Makefile.PL b/os2/OS2/REXX/Makefile.PL index 07f6cc6..c27cb0d 100644 --- a/os2/OS2/REXX/Makefile.PL +++ b/os2/OS2/REXX/Makefile.PL @@ -3,5 +3,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'OS2::REXX', VERSION => '0.2', + MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', ); diff --git a/os2/os2.c b/os2/os2.c index a35b706..14a6ea0 100644 --- 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] = '/'; + } } } diff --git a/os2/os2ish.h b/os2/os2ish.h index 0597fdc..d83503d 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -47,12 +47,6 @@ #define BIT_BUCKET "/dev/nul" /* Will this work? */ -/* SH_PATH_INI: - * Duplicate for SH_PATH. This symbol allows redefinition of SH_PATH, - * which may be needed to make a binary distribution. - */ -#define SH_PATH_INI SH_PATH /**/ - #if defined(I_SYS_UN) && !defined(TCPIPV4) /* It is not working without TCPIPV4 defined. */ # undef I_SYS_UN @@ -197,9 +191,7 @@ extern OS2_Perl_data_t OS2_Perl_data; } #define STATIC_FILE_LENGTH 127 -extern char sh_path[STATIC_FILE_LENGTH+1]; -#undef SH_PATH -#define SH_PATH sh_path + #define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n)) char *perllib_mangle(char *, unsigned int); diff --git a/patchlevel.h b/patchlevel.h index 8dc52bc..a2abcc1 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 9 +#define SUBVERSION 10 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/perl.h b/perl.h index f740c9a..16c119e 100644 --- a/perl.h +++ b/perl.h @@ -211,7 +211,7 @@ /* Use all the "standard" definitions? */ #if defined(STANDARD_C) && defined(I_STDLIB) # include -#endif /* STANDARD_C */ +#endif /* This comes after so we don't try to change the standard * library prototypes; we'll use our own in proto.h instead. */ @@ -244,6 +244,13 @@ #define MEM_SIZE Size_t +#if defined(STANDARD_C) && defined(I_STDDEF) +# include +# 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 #else @@ -832,6 +839,7 @@ typedef struct magic MAGIC; typedef struct xrv XRV; typedef struct xpv XPV; typedef struct xpviv XPVIV; +typedef struct xpvuv XPVUV; typedef struct xpvnv XPVNV; typedef struct xpvmg XPVMG; typedef struct xpvlv XPVLV; @@ -1157,6 +1165,14 @@ I32 unlnk _((char*)); # endif #endif +typedef Signal_t (*Sighandler_t) _((int)); + +#ifdef HAS_SIGACTION +typedef struct sigaction Sigsave_t; +#else +typedef Sighandler_t Sigsave_t; +#endif + #define SCAN_DEF 0 #define SCAN_TR 1 #define SCAN_REPL 2 @@ -1208,6 +1224,7 @@ EXT U32 origalen; EXT U32 * profiledata; EXT int maxo INIT(MAXO);/* Number of ops */ EXT char * osname; /* operating system */ +EXT char * sh_path INIT(SH_PATH); /* full path of shell */ EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */ EXT IV ** xiv_root; /* free xiv list--shared by interpreters */ @@ -1480,7 +1497,6 @@ EXT I32 lex_formbrack; /* bracket count at outer format level */ EXT I32 lex_fakebrack; /* outer bracket is mere delimiter */ EXT I32 lex_casemods; /* casemod count */ EXT I32 lex_dojoin; /* doing an array interpolation */ -EXT I32 lex_endscope; /* maybe end of scope; defer lexical vars */ EXT I32 lex_starts; /* how many interps done on level */ EXT SV * lex_stuff; /* runtime pattern from m// or s/// */ EXT SV * lex_repl; /* runtime replacement from s/// */ diff --git a/perl_exp.SH b/perl_exp.SH index 1c1848b..1753863 100755 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -5,6 +5,9 @@ # Create the export list for perl. # Needed by AIX to do dynamic linking. +# NOTE: If you're using 'old_embed.pl', don't use this script! +# Use 'old_perl_exp.SH' instead. + # This simple program relys on 'global.sym' being up to date # with all of the global symbols that a dynamicly link library # might want to access. @@ -19,10 +22,11 @@ echo "#!" > perl.exp sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym >> perl.exp +# # also add symbols from interp.sym # They are only needed if -DMULTIPLICITY is not set but it # doesn't hurt to include them anyway. -sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp +sed -n '/^[A-Za-z]/ s/^/Perl_/p' interp.sym >> perl.exp # extra globals not included above. cat <> perl.exp @@ -30,6 +34,9 @@ perl_init_i18nl10n perl_init_i18nl14n perl_new_collate perl_new_ctype +perl_new_numeric +perl_numeric_local +perl_numeric_standard perl_alloc perl_construct perl_destruct diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index df8d23f..ba45e55 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -334,6 +334,23 @@ syscall() interface to access setitimer(2) if your system supports it, or else see L 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 --- 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 --- a/pp.h +++ b/pp.h @@ -55,14 +55,14 @@ #define POPp (SvPVx(POPs, na)) #define POPn (SvNVx(POPs)) #define POPi ((IV)SvIVx(POPs)) -#define POPu ((UV)SvIVx(POPs)) +#define POPu ((UV)SvUVx(POPs)) #define POPl ((long)SvIVx(POPs)) #define TOPs (*sp) #define TOPp (SvPV(TOPs, na)) #define TOPn (SvNV(TOPs)) #define TOPi ((IV)SvIV(TOPs)) -#define TOPu ((UV)SvIV(TOPs)) +#define TOPu ((UV)SvUV(TOPs)) #define TOPl ((long)SvIV(TOPs)) /* Go to some pains in the rare event that we must extend the stack. */ @@ -110,12 +110,10 @@ #define dPOPPOPssrl SV *right = POPs; SV *left = POPs #define dPOPPOPnnrl double right = POPn; double left = POPn #define dPOPPOPiirl IV right = POPi; IV left = POPi -#define dPOPPOPuurl UV right = POPu; UV left = POPu #define dPOPTOPssrl SV *right = POPs; SV *left = TOPs #define dPOPTOPnnrl double right = POPn; double left = TOPn #define dPOPTOPiirl IV right = POPi; IV left = TOPi -#define dPOPTOPuurl UV right = POPu; UV left = TOPu #define RETPUSHYES RETURNX(PUSHs(&sv_yes)) #define RETPUSHNO RETURNX(PUSHs(&sv_no)) diff --git a/pp_sys.c b/pp_sys.c index d580fba..8af0072 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 () { - if (/sharpbang='(.*)'/) { - $sharpbang = ($1 eq '#!'); - last; +if ($^O eq 'os2' || $^O eq 'qnx') { + $sharpbang = 0; +} +else { + open(CONFIG, "../config.sh"); + while () { + if (/sharpbang='(.*)'/) { + $sharpbang = ($1 eq '#!'); + last; + } } + close(CONFIG); } -$sharpbang = 0 if $ENV{OS2_SHELL}; # OS/2 + $bad = 0; $good = 0; $total = @ARGV; diff --git a/t/lib/posix.t b/t/lib/posix.t index 3adc602..6ae88c0 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -61,8 +61,10 @@ print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n"; # Check string conversion functions. if ($Config{d_strtod}) { + $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale}; ($n, $x) = &POSIX::strtod('3.14159_OR_SO'); print (($n == 3.14159) && ($x == 6) ? "ok 14\n" : "not ok 14\n"); + &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale}; } else { print "# strtod not present\n", "ok 14\n"; } if ($Config{d_strtol}) { diff --git a/toke.c b/toke.c index b4c4d9e..7dd35cb 100644 --- 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 --- a/util.c +++ b/util.c @@ -42,6 +42,10 @@ # include #endif +#ifdef I_SYS_WAIT +# include +#endif + #define FLUSH #ifdef LEAKTEST @@ -446,7 +450,7 @@ perl_new_collate(newcoll) ++collation_ix; Safefree(collation_name); collation_name = savepv(newcoll); - collation_standard = strEQ(newcoll, "C"); + collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX")); #ifdef HAS_STRXFRM { @@ -490,7 +494,7 @@ perl_new_numeric(newnum) if (! numeric_name || strNE(numeric_name, newnum)) { Safefree(numeric_name); numeric_name = savepv(newnum); - numeric_standard = strEQ(newnum, "C"); + numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX")); numeric_local = TRUE; } } @@ -1778,13 +1782,127 @@ int newfd; } #endif + +#ifdef HAS_SIGACTION + +Sighandler_t +rsignal(signo, handler) +int signo; +Sighandler_t handler; +{ + struct sigaction act, oact; + + act.sa_handler = handler; + sigemptyset(&act.sa_mask); + act.sa_flags = 0; +#ifdef SA_RESTART + act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */ +#endif + if (sigaction(signo, &act, &oact) == -1) + return(SIG_ERR); + else + return(oact.sa_handler); +} + +Sighandler_t +rsignal_state(signo) +int signo; +{ + struct sigaction oact; + + if (sigaction(signo, (struct sigaction *)NULL, &oact) == -1) + return SIG_ERR; + else + return oact.sa_handler; +} + +int +rsignal_save(signo, handler, save) +int signo; +Sighandler_t handler; +Sigsave_t *save; +{ + struct sigaction act; + + act.sa_handler = handler; + sigemptyset(&act.sa_mask); + act.sa_flags = 0; +#ifdef SA_RESTART + act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */ +#endif + return sigaction(signo, &act, save); +} + +int +rsignal_restore(signo, save) +int signo; +Sigsave_t *save; +{ + return sigaction(signo, save, (struct sigaction *)NULL); +} + +#else /* !HAS_SIGACTION */ + +Sighandler_t +rsignal(signo, handler) +int signo; +Sighandler_t handler; +{ + return signal(signo, handler); +} + +static int sig_trapped; + +static +Signal_t +sig_trap(signo) +int signo; +{ + sig_trapped++; +} + +Sighandler_t +rsignal_state(signo) +int signo; +{ + Sighandler_t oldsig; + + sig_trapped = 0; + oldsig = signal(signo, sig_trap); + signal(signo, oldsig); + if (sig_trapped) + kill(getpid(), signo); + return oldsig; +} + +int +rsignal_save(signo, handler, save) +int signo; +Sighandler_t handler; +Sigsave_t *save; +{ + *save = signal(signo, handler); + return (*save == SIG_ERR) ? -1 : 0; +} + +int +rsignalrestore(signo, save) +int signo; +Sigsave_t *save; +{ + return (signal(signo, *save) == SIG_ERR) ? -1 : 0; +} + +#endif /* !HAS_SIGACTION */ + + #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \ && !defined(VMS) /* VMS' my_popen() is in VMS.c */ I32 my_pclose(ptr) PerlIO *ptr; { - Signal_t (*hstat)(), (*istat)(), (*qstat)(); + Sigsave_t hstat, istat, qstat; int status; SV **svp; int pid; @@ -1802,15 +1920,15 @@ PerlIO *ptr; #ifdef UTS if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ #endif - hstat = signal(SIGHUP, SIG_IGN); - istat = signal(SIGINT, SIG_IGN); - qstat = signal(SIGQUIT, SIG_IGN); + rsignal_save(SIGHUP, SIG_IGN, &hstat); + rsignal_save(SIGINT, SIG_IGN, &istat); + rsignal_save(SIGQUIT, SIG_IGN, &qstat); do { pid = wait4pid(pid, &status, 0); } while (pid == -1 && errno == EINTR); - signal(SIGHUP, hstat); - signal(SIGINT, istat); - signal(SIGQUIT, qstat); + rsignal_restore(SIGHUP, &hstat); + rsignal_restore(SIGINT, &istat); + rsignal_restore(SIGQUIT, &qstat); return(pid < 0 ? pid : status); } #endif /* !DOSISH */ diff --git a/x2p/proto.h b/x2p/proto.h new file mode 100644 index 0000000..eb5fb15 --- /dev/null +++ b/x2p/proto.h @@ -0,0 +1,8 @@ +/* proto.h + * + * Copyright (c) 1991-1996, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */